|
|
unit uFrmMain;
|
|
|
|
|
|
interface
|
|
|
|
|
|
uses
|
|
|
iocp.Http.Client, iocp.Utils.Str, DateUtils, RegularExpressions,
|
|
|
YxdJson, YxdStr, YxdHash, YxdWorker, ShellAPI, Math, StrUtils,
|
|
|
uBookSourceBean,
|
|
|
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
|
|
|
Dialogs, StdCtrls, ExtCtrls, Menus, SynEdit, SynMemo, ComCtrls, SyncObjs,
|
|
|
SynEditHighlighter, SynHighlighterJSON, Vcl.Buttons;
|
|
|
|
|
|
type
|
|
|
PProcessState = ^TProcessState;
|
|
|
TProcessState = record
|
|
|
STime: Int64;
|
|
|
NeedFree: Boolean;
|
|
|
Min: Integer;
|
|
|
Max: Integer;
|
|
|
Value: Integer;
|
|
|
end;
|
|
|
|
|
|
type
|
|
|
TForm1 = class(TForm)
|
|
|
Panel1: TPanel;
|
|
|
SrcList: TListBox;
|
|
|
Splitter1: TSplitter;
|
|
|
Panel2: TPanel;
|
|
|
PopupMenu1: TPopupMenu;
|
|
|
C1: TMenuItem;
|
|
|
Panel3: TPanel;
|
|
|
EditData: TSynMemo;
|
|
|
Button1: TButton;
|
|
|
Panel4: TPanel;
|
|
|
lbCount: TLabel;
|
|
|
bookGroupList: TComboBox;
|
|
|
StatusBar1: TStatusBar;
|
|
|
ProgressBar1: TProgressBar;
|
|
|
SynJSONSyn1: TSynJSONSyn;
|
|
|
PopupMenu2: TPopupMenu;
|
|
|
S1: TMenuItem;
|
|
|
N1: TMenuItem;
|
|
|
C2: TMenuItem;
|
|
|
X1: TMenuItem;
|
|
|
P1: TMenuItem;
|
|
|
A1: TMenuItem;
|
|
|
N2: TMenuItem;
|
|
|
N3: TMenuItem;
|
|
|
R1: TMenuItem;
|
|
|
Z1: TMenuItem;
|
|
|
N4: TMenuItem;
|
|
|
W1: TMenuItem;
|
|
|
Label1: TLabel;
|
|
|
Edit1: TEdit;
|
|
|
CheckBox1: TCheckBox;
|
|
|
CheckBox2: TCheckBox;
|
|
|
D1: TMenuItem;
|
|
|
N6: TMenuItem;
|
|
|
C3: TMenuItem;
|
|
|
N5: TMenuItem;
|
|
|
S2: TMenuItem;
|
|
|
G1: TMenuItem;
|
|
|
N7: TMenuItem;
|
|
|
E1: TMenuItem;
|
|
|
Timer1: TTimer;
|
|
|
CheckBox3: TCheckBox;
|
|
|
MainMenu1: TMainMenu;
|
|
|
F1: TMenuItem;
|
|
|
H1: TMenuItem;
|
|
|
E2: TMenuItem;
|
|
|
I1: TMenuItem;
|
|
|
SaveDialog1: TSaveDialog;
|
|
|
W2: TMenuItem;
|
|
|
N8: TMenuItem;
|
|
|
R2: TMenuItem;
|
|
|
N9: TMenuItem;
|
|
|
H2: TMenuItem;
|
|
|
E3: TMenuItem;
|
|
|
H3: TMenuItem;
|
|
|
N10: TMenuItem;
|
|
|
N11: TMenuItem;
|
|
|
T1: TMenuItem;
|
|
|
Panel5: TPanel;
|
|
|
Splitter2: TSplitter;
|
|
|
Label2: TLabel;
|
|
|
edtLog: TSynMemo;
|
|
|
SpeedButton1: TSpeedButton;
|
|
|
StaticText1: TStaticText;
|
|
|
O1: TMenuItem;
|
|
|
N12: TMenuItem;
|
|
|
OpenDialog1: TOpenDialog;
|
|
|
A2: TMenuItem;
|
|
|
C4: TMenuItem;
|
|
|
X2: TMenuItem;
|
|
|
P2: TMenuItem;
|
|
|
N13: TMenuItem;
|
|
|
B1: TMenuItem;
|
|
|
F2: TMenuItem;
|
|
|
N14: TMenuItem;
|
|
|
CheckBox4: TCheckBox;
|
|
|
N15: TMenuItem;
|
|
|
N16: TMenuItem;
|
|
|
N17: TMenuItem;
|
|
|
N18: TMenuItem;
|
|
|
S3: TMenuItem;
|
|
|
B2: TMenuItem;
|
|
|
B3: TMenuItem;
|
|
|
URLU1: TMenuItem;
|
|
|
N19: TMenuItem;
|
|
|
URL1: TMenuItem;
|
|
|
RadioButton1: TRadioButton;
|
|
|
RadioButton2: TRadioButton;
|
|
|
RadioButton3: TRadioButton;
|
|
|
RadioButton4: TRadioButton;
|
|
|
CheckBox5: TCheckBox;
|
|
|
N20: TMenuItem;
|
|
|
U1: TMenuItem;
|
|
|
W3: TMenuItem;
|
|
|
Panel6: TPanel;
|
|
|
Button2: TButton;
|
|
|
Button3: TButton;
|
|
|
Button4: TButton;
|
|
|
Button5: TButton;
|
|
|
Shape1: TShape;
|
|
|
CheckBox6: TCheckBox;
|
|
|
O2: TMenuItem;
|
|
|
procedure FormCreate(Sender: TObject);
|
|
|
procedure C1Click(Sender: TObject);
|
|
|
procedure FormShow(Sender: TObject);
|
|
|
procedure SrcListKeyDown(Sender: TObject; var Key: Word;
|
|
|
Shift: TShiftState);
|
|
|
procedure FormDestroy(Sender: TObject);
|
|
|
procedure SrcListData(Control: TWinControl; Index: Integer;
|
|
|
var Data: string);
|
|
|
procedure PopupMenu2Popup(Sender: TObject);
|
|
|
procedure R1Click(Sender: TObject);
|
|
|
procedure Z1Click(Sender: TObject);
|
|
|
procedure C2Click(Sender: TObject);
|
|
|
procedure X1Click(Sender: TObject);
|
|
|
procedure P1Click(Sender: TObject);
|
|
|
procedure A1Click(Sender: TObject);
|
|
|
procedure S1Click(Sender: TObject);
|
|
|
procedure SrcListClick(Sender: TObject);
|
|
|
procedure EditDataChange(Sender: TObject);
|
|
|
procedure W1Click(Sender: TObject);
|
|
|
procedure D1Click(Sender: TObject);
|
|
|
procedure C3Click(Sender: TObject);
|
|
|
procedure Button1Click(Sender: TObject);
|
|
|
procedure Timer1Timer(Sender: TObject);
|
|
|
procedure bookGroupListChange(Sender: TObject);
|
|
|
procedure N7Click(Sender: TObject);
|
|
|
procedure E1Click(Sender: TObject);
|
|
|
procedure SrcListDblClick(Sender: TObject);
|
|
|
procedure I1Click(Sender: TObject);
|
|
|
procedure E2Click(Sender: TObject);
|
|
|
procedure W2Click(Sender: TObject);
|
|
|
procedure R2Click(Sender: TObject);
|
|
|
procedure S2Click(Sender: TObject);
|
|
|
procedure G1Click(Sender: TObject);
|
|
|
procedure H2Click(Sender: TObject);
|
|
|
procedure T1Click(Sender: TObject);
|
|
|
procedure SpeedButton1Click(Sender: TObject);
|
|
|
procedure O1Click(Sender: TObject);
|
|
|
procedure A2Click(Sender: TObject);
|
|
|
procedure PopupMenu1Popup(Sender: TObject);
|
|
|
procedure C4Click(Sender: TObject);
|
|
|
procedure X2Click(Sender: TObject);
|
|
|
procedure P2Click(Sender: TObject);
|
|
|
procedure B1Click(Sender: TObject);
|
|
|
procedure F2Click(Sender: TObject);
|
|
|
procedure N14Click(Sender: TObject);
|
|
|
procedure N15Click(Sender: TObject);
|
|
|
procedure N17Click(Sender: TObject);
|
|
|
procedure S3Click(Sender: TObject);
|
|
|
procedure N18Click(Sender: TObject);
|
|
|
procedure B2Click(Sender: TObject);
|
|
|
procedure URL1Click(Sender: TObject);
|
|
|
procedure RadioButton1Click(Sender: TObject);
|
|
|
procedure RadioButton2Click(Sender: TObject);
|
|
|
procedure RadioButton3Click(Sender: TObject);
|
|
|
procedure RadioButton4Click(Sender: TObject);
|
|
|
procedure U1Click(Sender: TObject);
|
|
|
procedure W3Click(Sender: TObject);
|
|
|
procedure Button2Click(Sender: TObject);
|
|
|
procedure Button3Click(Sender: TObject);
|
|
|
procedure Button4Click(Sender: TObject);
|
|
|
procedure Button5Click(Sender: TObject);
|
|
|
procedure O2Click(Sender: TObject);
|
|
|
procedure Button6Click(Sender: TObject);
|
|
|
private
|
|
|
{ Private declarations }
|
|
|
OldListWndProc, OldTextWndProc: TWndMethod;
|
|
|
FBookSrcData: JSONArray;
|
|
|
FBookCopyData: JSONArray;
|
|
|
FBookGroups: TStringHash;
|
|
|
FIsChange, FChanging: Boolean;
|
|
|
FCurIndex: Integer;
|
|
|
|
|
|
FWaitStop: Integer;
|
|
|
FTaskRef: Integer;
|
|
|
FTaskStartTime: Int64;
|
|
|
FCheckLastTime: Int64;
|
|
|
FMaxWorkers: Integer;
|
|
|
|
|
|
FFilterList: TList;
|
|
|
FCurCheckIndex: Integer;
|
|
|
FCheckCount, FCheckFinish: Integer;
|
|
|
FAutoFind, FAutoDel, FAllSrc, FAutoScore: Boolean;
|
|
|
|
|
|
FWaitCheckBookSourceSingId: Integer;
|
|
|
|
|
|
FLocker: TCriticalSection;
|
|
|
FStateMsg: string;
|
|
|
FLastSortFlag: Integer;
|
|
|
FLastFindSource: string;
|
|
|
FBookType: string;
|
|
|
procedure SetBookType(const Value: string);
|
|
|
|
|
|
protected
|
|
|
procedure SrcListWndProc(var Message: TMessage);
|
|
|
procedure SrcListTextWndProc(var Message: TMessage);
|
|
|
procedure AddSrcFiles(ADrop: Integer);
|
|
|
procedure WMDropFiles(var Msg: TWMDropFiles); message WM_DROPFILES;
|
|
|
public
|
|
|
{ Public declarations }
|
|
|
function CheckItem(Item: TBookSourceItem): Boolean;
|
|
|
function CheckSaveState(): Boolean;
|
|
|
|
|
|
|
|
|
function CheckBookSourceItem(Item: TBookSourceItem; RaiseErr: Boolean = False; OutLog: TStrings = nil): Boolean; overload;
|
|
|
function CheckBookSourceItem(Item: TBookSourceItem; Http: THttpClient; Header: THttpHeaders; RaiseErr: Boolean = False; OutLog: TStrings = nil): Boolean; overload;
|
|
|
|
|
|
procedure AddSrcFile(const FileName: string);
|
|
|
procedure UpdateBookGroup(Item: TBookSourceItem);
|
|
|
|
|
|
procedure RemoveRepeat(AJob: PJob);
|
|
|
procedure WaitCheckBookSource(AJob: PJob);
|
|
|
procedure DoCheckBookSourceItem(AJob: PJob);
|
|
|
|
|
|
procedure TaskFinish(AJob: PJob);
|
|
|
procedure DoNotifyDataChange(AJob: PJob);
|
|
|
procedure DoUpdateProcess(AJob: PJob);
|
|
|
|
|
|
procedure Log(const Msg: string);
|
|
|
procedure LogD(const Msg: string);
|
|
|
procedure DispLog();
|
|
|
procedure NotifyListChange(Flag: Integer = 0);
|
|
|
|
|
|
procedure RemoveSelected();
|
|
|
procedure CopySelected();
|
|
|
procedure Paste();
|
|
|
procedure CutSelectedt();
|
|
|
procedure FindSource(const FindStr: string);
|
|
|
procedure EditSource(Item: TBookSourceItem);
|
|
|
procedure ExportSelectedToFile();
|
|
|
|
|
|
procedure ChangeItemIndex(const CurIndex, NewIndex: Integer);
|
|
|
|
|
|
property BookType: string read FBookType write SetBookType;
|
|
|
end;
|
|
|
|
|
|
var
|
|
|
Form1: TForm1;
|
|
|
|
|
|
implementation
|
|
|
|
|
|
{$R *.dfm}
|
|
|
|
|
|
uses
|
|
|
uFrmWait, uFrmEditSource, uFrmReplaceGroup;
|
|
|
|
|
|
function GetCurJavaDateTime(): Int64;
|
|
|
begin
|
|
|
Result := Round(((Now - 25569) * 86400000 - 3600000 * 8) / 1000);
|
|
|
end;
|
|
|
|
|
|
procedure CutOrCopyFiles(FileList: AnsiString; bCopy: Boolean);
|
|
|
type
|
|
|
PDropFiles = ^TDropFiles;
|
|
|
|
|
|
TDropFiles = record
|
|
|
pfiles: DWORD;
|
|
|
pt: TPoint;
|
|
|
fNC: BOOL;
|
|
|
fwide: BOOL;
|
|
|
end;
|
|
|
const
|
|
|
DROPEFFECT_COPY = 1;
|
|
|
DROPEFFECT_MOVE = 2;
|
|
|
var
|
|
|
hGblFileList: hGlobal;
|
|
|
pFileListDate: Pbyte;
|
|
|
HandleDropEffect: UINT;
|
|
|
hGblDropEffect: hGlobal;
|
|
|
pdwDropEffect: PDWORD;
|
|
|
iLen: Integer;
|
|
|
begin
|
|
|
iLen := Length(FileList) + 2;
|
|
|
FileList := FileList + #0#0;
|
|
|
hGblFileList := GlobalAlloc(GMEM_ZEROINIT or GMEM_MOVEABLE or GMEM_SHARE,
|
|
|
SizeOf(TDropFiles) + iLen);
|
|
|
pFileListDate := GlobalLock(hGblFileList);
|
|
|
PDropFiles(pFileListDate)^.pfiles := SizeOf(TDropFiles);
|
|
|
PDropFiles(pFileListDate)^.pt.Y := 0;
|
|
|
PDropFiles(pFileListDate)^.pt.X := 0;
|
|
|
PDropFiles(pFileListDate)^.fNC := False;
|
|
|
PDropFiles(pFileListDate)^.fwide := False;
|
|
|
Inc(pFileListDate, SizeOf(TDropFiles));
|
|
|
CopyMemory(pFileListDate, @FileList[1], iLen);
|
|
|
GlobalUnlock(hGblFileList);
|
|
|
HandleDropEffect := RegisterClipboardFormat('Preferred DropEffect ');
|
|
|
hGblDropEffect := GlobalAlloc(GMEM_ZEROINIT or GMEM_MOVEABLE or GMEM_SHARE,
|
|
|
SizeOf(DWORD));
|
|
|
pdwDropEffect := GlobalLock(hGblDropEffect);
|
|
|
if (bCopy) then pdwDropEffect^ := DROPEFFECT_COPY
|
|
|
else pdwDropEffect^ := DROPEFFECT_MOVE;
|
|
|
GlobalUnlock(hGblDropEffect);
|
|
|
if OpenClipboard(0) then begin
|
|
|
EmptyClipboard();
|
|
|
SetClipboardData(HandleDropEffect, hGblDropEffect);
|
|
|
SetClipboardData(CF_HDROP, hGblFileList);
|
|
|
CloseClipboard();
|
|
|
end;
|
|
|
end;
|
|
|
|
|
|
// <EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ļ<EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ļ<EFBFBD><EFBFBD><EFBFBD> #0 <EFBFBD>ָ<EFBFBD>
|
|
|
procedure CopyFileClipbrd(const FName: string);
|
|
|
begin
|
|
|
CutOrCopyFiles(AnsiString(FName), True);
|
|
|
end;
|
|
|
|
|
|
procedure TForm1.AddSrcFiles(ADrop: Integer);
|
|
|
var
|
|
|
i: Integer;
|
|
|
p: array[0..1023] of Char;
|
|
|
begin
|
|
|
for i := 0 to DragQueryFile(ADrop, $FFFFFFFF, nil, 0) - 1 do begin
|
|
|
DragQueryFile(ADrop, i, p, 1024);
|
|
|
AddSrcFile(StrPas(p));
|
|
|
end;
|
|
|
end;
|
|
|
|
|
|
procedure TForm1.B1Click(Sender: TObject);
|
|
|
var
|
|
|
FindStr, NewStr: string;
|
|
|
I, Flag: Integer;
|
|
|
Item: TBookSourceItem;
|
|
|
begin
|
|
|
Flag := 1;
|
|
|
if ShowReplaceGroup(Self, '<EFBFBD>滻 - <EFBFBD><EFBFBD>Դ<EFBFBD><EFBFBD><EFBFBD><EFBFBD>', FindStr, NewStr, Flag) then begin
|
|
|
if (FindStr <> '') and (Flag = 0) then
|
|
|
Exit;
|
|
|
for I := 0 to FBookSrcData.Count - 1 do begin
|
|
|
Item := TBookSourceItem(FBookSrcData.O[I]);
|
|
|
if not Assigned(Item) then Continue;
|
|
|
Item.bookSourceName := StringReplace(Trim(Item.bookSourceName), FindStr, NewStr, [rfReplaceAll, rfIgnoreCase]);
|
|
|
end;
|
|
|
NotifyListChange();
|
|
|
end;
|
|
|
end;
|
|
|
|
|
|
procedure TForm1.B2Click(Sender: TObject);
|
|
|
var
|
|
|
FindStr, NewStr: string;
|
|
|
I, Flag: Integer;
|
|
|
Item: TBookSourceItem;
|
|
|
begin
|
|
|
Flag := 1;
|
|
|
if ShowReplaceGroup(Self, '<EFBFBD>滻 - <EFBFBD><EFBFBD>ԴURL', FindStr, NewStr, Flag) then begin
|
|
|
if (FindStr <> '') and (Flag = 0) then
|
|
|
Exit;
|
|
|
for I := 0 to FBookSrcData.Count - 1 do begin
|
|
|
Item := TBookSourceItem(FBookSrcData.O[I]);
|
|
|
if not Assigned(Item) then Continue;
|
|
|
Item.bookSourceUrl := StringReplace(Trim(Item.bookSourceUrl), FindStr, NewStr, [rfReplaceAll, rfIgnoreCase]);
|
|
|
end;
|
|
|
NotifyListChange();
|
|
|
end;
|
|
|
end;
|
|
|
|
|
|
procedure TForm1.bookGroupListChange(Sender: TObject);
|
|
|
begin
|
|
|
if FChanging then
|
|
|
Exit;
|
|
|
FChanging := True;
|
|
|
try
|
|
|
EditData.Text := '';
|
|
|
FIsChange := False;
|
|
|
FCurIndex := -1;
|
|
|
NotifyListChange(1);
|
|
|
finally
|
|
|
FChanging := False;
|
|
|
end;
|
|
|
end;
|
|
|
|
|
|
procedure TForm1.Button1Click(Sender: TObject);
|
|
|
begin
|
|
|
if Button1.Tag = 0 then begin
|
|
|
Button1.Tag := 1;
|
|
|
Button1.Caption := 'ֹͣ(&S)';
|
|
|
|
|
|
FTaskRef := 0;
|
|
|
FWaitStop := 0;
|
|
|
FCheckLastTime := GetTimestamp;
|
|
|
FTaskStartTime := GetTimestamp;
|
|
|
FMaxWorkers := Max(1, StrToIntDef(Edit1.Text, 8));
|
|
|
Workers.MaxWorkers := FMaxWorkers;
|
|
|
|
|
|
edtLog.Lines.Clear;
|
|
|
Log('<EFBFBD><EFBFBD><EFBFBD>ڳ<EFBFBD>ʼ<EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>...');
|
|
|
|
|
|
Timer1.Enabled := True;
|
|
|
ProgressBar1.Min := 0;
|
|
|
ProgressBar1.Max := 100;
|
|
|
ProgressBar1.Position := 0;
|
|
|
|
|
|
FAutoFind := CheckBox4.Checked;
|
|
|
FAutoDel := CheckBox1.Checked;
|
|
|
FAllSrc := CheckBox5.Checked;
|
|
|
FAutoScore := CheckBox6.Checked;
|
|
|
|
|
|
if FAutoDel or FAutoFind then begin
|
|
|
Inc(FTaskRef);
|
|
|
Log('<EFBFBD><EFBFBD><EFBFBD>ڴ<EFBFBD><EFBFBD><EFBFBD>...');
|
|
|
Workers.Post(RemoveRePeat, Pointer(Integer(CheckBox3.Checked)));
|
|
|
end;
|
|
|
if CheckBox2.Checked then begin
|
|
|
Inc(FTaskRef);
|
|
|
if not CheckBox1.Checked then
|
|
|
Workers.SendSignal(FWaitCheckBookSourceSingId);
|
|
|
end;
|
|
|
|
|
|
ShowWaitDlg();
|
|
|
end else begin
|
|
|
AtomicIncrement(FTaskRef);
|
|
|
if AtomicDecrement(FTaskRef) <= 0 then begin
|
|
|
Button1.Tag := 0;
|
|
|
Button1.Caption := '<EFBFBD><EFBFBD>ʼ<EFBFBD><EFBFBD><EFBFBD><EFBFBD>(&B)';
|
|
|
Timer1.Enabled := False;
|
|
|
FTaskStartTime := 0;
|
|
|
ProgressBar1.Visible := False;
|
|
|
HideWaitDlg;
|
|
|
Log('<EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>');
|
|
|
end else begin
|
|
|
Button1.Tag := 2;
|
|
|
Button1.Caption := '<EFBFBD><EFBFBD><EFBFBD><EFBFBD>ֹͣ...';
|
|
|
AtomicIncrement(FWaitStop);
|
|
|
end;
|
|
|
end;
|
|
|
//Application.ProcessMessages;
|
|
|
end;
|
|
|
|
|
|
procedure TForm1.Button2Click(Sender: TObject);
|
|
|
begin
|
|
|
ChangeItemIndex(SrcList.ItemIndex, 0);
|
|
|
end;
|
|
|
|
|
|
procedure TForm1.Button3Click(Sender: TObject);
|
|
|
begin
|
|
|
ChangeItemIndex(SrcList.ItemIndex, SrcList.ItemIndex - 1);
|
|
|
end;
|
|
|
|
|
|
procedure TForm1.Button4Click(Sender: TObject);
|
|
|
begin
|
|
|
ChangeItemIndex(SrcList.ItemIndex, SrcList.ItemIndex + 1);
|
|
|
end;
|
|
|
|
|
|
procedure TForm1.Button5Click(Sender: TObject);
|
|
|
begin
|
|
|
ChangeItemIndex(SrcList.ItemIndex, SrcList.Count - 1);
|
|
|
end;
|
|
|
|
|
|
procedure TForm1.Button6Click(Sender: TObject);
|
|
|
var
|
|
|
url: string;
|
|
|
begin
|
|
|
url := 'http://www.baidu.com/<searchPage+1>?aaa=0';
|
|
|
url := TRegEx.Replace(url, '<searchPage([-+]1)>', '{{page$1}}', [roIgnoreCase]);
|
|
|
ShowMessage(url);
|
|
|
end;
|
|
|
|
|
|
procedure TForm1.A1Click(Sender: TObject);
|
|
|
begin
|
|
|
EditData.SelectAll;
|
|
|
end;
|
|
|
|
|
|
procedure TForm1.A2Click(Sender: TObject);
|
|
|
begin
|
|
|
OpenDialog1.Title := '<EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Դ<EFBFBD>ļ<EFBFBD>';
|
|
|
if OpenDialog1.Execute(Handle) then
|
|
|
AddSrcFile(OpenDialog1.FileName);
|
|
|
end;
|
|
|
|
|
|
procedure TForm1.AddSrcFile(const FileName: string);
|
|
|
var
|
|
|
Data: JSONArray;
|
|
|
Item: TBookSourceItem;
|
|
|
I: Integer;
|
|
|
begin
|
|
|
Data := JSONArray.Create;
|
|
|
try
|
|
|
Data.LoadFromFile(FileName);
|
|
|
I := Data.Count;
|
|
|
while I > 0 do begin
|
|
|
try
|
|
|
Item := TBookSourceItem(Data.O[0]);
|
|
|
if Assigned(Item) and (Item.bookSourceUrl <> '') then begin
|
|
|
UpdateBookGroup(Item);
|
|
|
FBookSrcData.Add(Data.O[0]);
|
|
|
end;
|
|
|
except
|
|
|
end;
|
|
|
Dec(I);
|
|
|
end;
|
|
|
finally
|
|
|
Data.Free;
|
|
|
NotifyListChange;
|
|
|
end;
|
|
|
end;
|
|
|
|
|
|
procedure TForm1.C1Click(Sender: TObject);
|
|
|
begin
|
|
|
FBookSrcData.Clear;
|
|
|
NotifyListChange;
|
|
|
end;
|
|
|
|
|
|
procedure TForm1.C2Click(Sender: TObject);
|
|
|
begin
|
|
|
EditData.CopyToClipboard;
|
|
|
end;
|
|
|
|
|
|
procedure TForm1.C3Click(Sender: TObject);
|
|
|
var
|
|
|
S: string;
|
|
|
Item, NewItem: TBookSourceItem;
|
|
|
begin
|
|
|
if SrcList.ItemIndex < 0 then Exit;
|
|
|
if not CheckSaveState then Exit;
|
|
|
Item := TBookSourceItem(FFilterList[SrcList.ItemIndex]);
|
|
|
S := InputBox('<EFBFBD><EFBFBD>Դ<EFBFBD><EFBFBD><EFBFBD><EFBFBD>', '<EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Դ<EFBFBD><EFBFBD><EFBFBD><EFBFBD>', Item.bookSourceName);
|
|
|
|
|
|
NewItem := TBookSourceItem(FBookSrcData.AddChildObject);
|
|
|
NewItem.Parse(Item.ToString);
|
|
|
NewItem.bookSourceName := S;
|
|
|
|
|
|
NotifyListChange;
|
|
|
if FFilterList.Count > 0 then
|
|
|
SrcList.ItemIndex := FFilterList.Count - 1;
|
|
|
end;
|
|
|
|
|
|
procedure TForm1.C4Click(Sender: TObject);
|
|
|
begin
|
|
|
CopySelected;
|
|
|
end;
|
|
|
|
|
|
function TForm1.CheckBookSourceItem(Item: TBookSourceItem; RaiseErr: Boolean; OutLog: TStrings): Boolean;
|
|
|
var
|
|
|
Http: THttpClient;
|
|
|
Header: THttpHeaders;
|
|
|
begin
|
|
|
Result := False;
|
|
|
try
|
|
|
if not Assigned(Item) then Exit;
|
|
|
Http := THttpClient.Create(nil);
|
|
|
if Assigned(OutLog) then begin
|
|
|
Http.ConnectionTimeOut := 6000;
|
|
|
Http.RecvTimeOut := 30000;
|
|
|
end else begin
|
|
|
Http.ConnectionTimeOut := 30000;
|
|
|
Http.RecvTimeOut := 30000;
|
|
|
end;
|
|
|
Header := THttpHeaders.Create;
|
|
|
|
|
|
FAutoScore := True;
|
|
|
Result := CheckBookSourceItem(Item, Http, Header, RaiseErr, OutLog);
|
|
|
|
|
|
finally
|
|
|
FreeAndNil(Http);
|
|
|
FreeAndNil(Header);
|
|
|
end;
|
|
|
end;
|
|
|
|
|
|
procedure TForm1.ChangeItemIndex(const CurIndex, NewIndex: Integer);
|
|
|
var
|
|
|
Item1, Item2: TBookSourceItem;
|
|
|
I1, I2, NIndex: Integer;
|
|
|
begin
|
|
|
if CurIndex < 0 then Exit;
|
|
|
if SrcList.Count <= 1 then Exit;
|
|
|
NIndex := NewIndex;
|
|
|
if NIndex >= SrcList.Count then
|
|
|
NIndex := SrcList.Count - 1;
|
|
|
if NIndex < 0 then Exit;
|
|
|
if NIndex = CurIndex then Exit;
|
|
|
|
|
|
Item1 := TBookSourceItem(FFilterList[CurIndex]);
|
|
|
Item2 := TBookSourceItem(FFilterList[NIndex]);
|
|
|
|
|
|
I1 := FBookSrcData.IndexOfObject(Item1);
|
|
|
I2 := FBookSrcData.IndexOfObject(Item2);
|
|
|
|
|
|
if I1 < 0 then Exit;
|
|
|
if I2 < 0 then Exit;
|
|
|
|
|
|
FBookSrcData.MoveItem(I1, I2);
|
|
|
FCurIndex := NIndex;
|
|
|
NotifyListChange(1);
|
|
|
end;
|
|
|
|
|
|
function TForm1.CheckBookSourceItem(Item: TBookSourceItem; Http: THttpClient;
|
|
|
Header: THttpHeaders; RaiseErr: Boolean; OutLog: TStrings): Boolean;
|
|
|
|
|
|
function ValidationURL(const BaseURL, URL: string): string;
|
|
|
begin
|
|
|
if (BaseURL <> '') and (BaseURL <> '-') and (URL <> '-') and (Pos('://', URL) < 1) then begin
|
|
|
if URL = '' then
|
|
|
Result := BaseURL
|
|
|
else if URL[1] = '/' then begin
|
|
|
if BaseURL[Length(BaseURL)] = '/' then
|
|
|
Result := BaseURL + URL.Substring(2)
|
|
|
else
|
|
|
Result := BaseURL + URL
|
|
|
end else begin
|
|
|
if BaseURL[Length(BaseURL)] = '/' then
|
|
|
Result := BaseURL + URL
|
|
|
else
|
|
|
Result := BaseURL + '/' + URL;
|
|
|
end;
|
|
|
end else
|
|
|
Result := URL;
|
|
|
Result := StringReplace(Result, '=searchPage', '=1', [rfReplaceAll, rfIgnoreCase]);
|
|
|
end;
|
|
|
|
|
|
function CheckURL(const URL, Title: string; RaiseErr: Boolean = False; Try404: Boolean = False): Boolean;
|
|
|
var
|
|
|
Resp: THttpResult;
|
|
|
Msg: string;
|
|
|
begin
|
|
|
Result := (URL <> '') and (URL <> '-') and (Pos('http', LowerCase(URL)) = 1);
|
|
|
if Result then begin
|
|
|
try
|
|
|
Resp := Http.Get(UrlEncodeEx(URL), nil, Header);
|
|
|
if (Resp.StatusCode = 200) or (Try404 and (Resp.StatusCode >= 400) and (Resp.StatusCode < 500)) then begin
|
|
|
Result := True;
|
|
|
if Assigned(OutLog) then OutLog.Add(Title + '<EFBFBD><EFBFBD><EFBFBD>ӳɹ<EFBFBD>.');
|
|
|
end else begin
|
|
|
Result := False;
|
|
|
Msg := Format('%s<EFBFBD><EFBFBD><EFBFBD><EFBFBD>ʧ<EFBFBD><EFBFBD>(StatusCode: %d, %s).', [Title, Resp.StatusCode, URL]);
|
|
|
if Assigned(OutLog) then OutLog.Add(Msg);
|
|
|
if RaiseErr then
|
|
|
raise Exception.Create(Msg);
|
|
|
end;
|
|
|
except
|
|
|
Result := False;
|
|
|
Msg := Format('%s<EFBFBD><EFBFBD><EFBFBD>Գ<EFBFBD><EFBFBD><EFBFBD>(%s).', [Title, Exception(ExceptObject).Message]);
|
|
|
if Assigned(OutLog) then OutLog.Add(Msg);
|
|
|
if RaiseErr then
|
|
|
raise Exception.Create(Msg);
|
|
|
end;
|
|
|
end else if Assigned(OutLog) then
|
|
|
OutLog.Add('<EFBFBD><EFBFBD>Ч<EFBFBD><EFBFBD>' + Title + '.');
|
|
|
end;
|
|
|
|
|
|
// <EFBFBD><EFBFBD><EFBFBD>ⷢ<EFBFBD><EFBFBD><EFBFBD>б<EFBFBD>
|
|
|
function CheckFindURL(AItem: TBookSourceItem; const BaseURL, Text, Title: string; RaiseErr: Boolean): Boolean;
|
|
|
var
|
|
|
I, J, L: Integer;
|
|
|
Msg, Item, SubTitle, AURL: string;
|
|
|
begin
|
|
|
Result := False;
|
|
|
if Text = '' then begin
|
|
|
Result := True;
|
|
|
Exit;
|
|
|
end;
|
|
|
try
|
|
|
J := 1;
|
|
|
while (J > 0) and (J <= Length(Text)) do begin
|
|
|
I := PosEx('&&', Text, J);
|
|
|
L := 2;
|
|
|
if I <= 0 then begin
|
|
|
I := PosEx(#$A, Text, J);
|
|
|
L := 1;
|
|
|
end;
|
|
|
if I > 0 then begin
|
|
|
Item := MidStr(Text, J, I - J);
|
|
|
J := I + L;
|
|
|
end else begin
|
|
|
Item := Trim(RightStr(Text, Length(Text) - J + 1));
|
|
|
J := Length(Text) + 1;
|
|
|
end;
|
|
|
|
|
|
if (Item = #$A) or (Item = #13) then
|
|
|
Continue;
|
|
|
|
|
|
Item := StringReplace(Item, #13, '', [rfReplaceAll]);
|
|
|
Item := StringReplace(Item, #10, '', [rfReplaceAll]);
|
|
|
Item := StringReplace(Item, '\n', '', [rfReplaceAll, rfIgnoreCase]);
|
|
|
Item := Trim(Item);
|
|
|
|
|
|
I := Pos('::', Item);
|
|
|
if (Item = '') or (I < 1) then begin
|
|
|
if FAutoScore then
|
|
|
AItem.score := AItem.score - 20;
|
|
|
if Assigned(OutLog) then
|
|
|
OutLog.Add('<EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>б<EFBFBD><EFBFBD><EFBFBD>ʽ<EFBFBD><EFBFBD><EFBFBD><EFBFBD>');
|
|
|
Continue;
|
|
|
end else begin
|
|
|
SubTitle := Trim(LeftStr(Item, I - 1));
|
|
|
AURL := Trim(RightStr(Item, Length(Item) - I - 1));
|
|
|
if not CheckURL(ValidationURL(BaseURL, AURL), '<EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>б<EFBFBD><EFBFBD>' + SubTitle + '<EFBFBD><EFBFBD>') then
|
|
|
AItem.score := AItem.score - 1;
|
|
|
end;
|
|
|
end;
|
|
|
except
|
|
|
Result := False;
|
|
|
Msg := Format('%s<EFBFBD><EFBFBD><EFBFBD>Գ<EFBFBD><EFBFBD><EFBFBD>(%s).', [Title, Exception(ExceptObject).Message]);
|
|
|
if Assigned(OutLog) then OutLog.Add(Msg);
|
|
|
if RaiseErr then
|
|
|
raise Exception.Create(Msg);
|
|
|
end;
|
|
|
end;
|
|
|
|
|
|
var
|
|
|
T: Int64;
|
|
|
AScore, I: Integer;
|
|
|
URL: string;
|
|
|
Json: JSONObject;
|
|
|
begin
|
|
|
Result := False;
|
|
|
if not Assigned(Item) then Exit;
|
|
|
Json := JSONObject.Create;
|
|
|
try
|
|
|
if Item.bookSourceUrl <> '' then begin
|
|
|
T := GetTimestamp;
|
|
|
if FAutoScore then
|
|
|
Item.score := 0;
|
|
|
Header.Clear;
|
|
|
Header.Add('User-Agent', 'Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/81.0.4044.138 Safari/537.36');
|
|
|
if Item.header <> '' then begin
|
|
|
if Json.Parse(Item.header, True) then begin
|
|
|
for I := 0 to Json.Count do
|
|
|
Header.Add(Json.Items[i].FName, Json.Items[i].AsString);
|
|
|
end;
|
|
|
end;
|
|
|
|
|
|
// <EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ԴURL
|
|
|
Result := CheckURL(Trim(Item.bookSourceUrl), '<EFBFBD><EFBFBD>ԴURL', RaiseErr, True);
|
|
|
|
|
|
if Result then begin
|
|
|
if FAutoScore then
|
|
|
Item.score := Item.score + 50;
|
|
|
// <EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>URL
|
|
|
URL := Trim(Item.searchUrl);
|
|
|
if CheckURL(ValidationURL(Trim(Item.bookSourceUrl), URL), '<EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ַ', RaiseErr) then begin
|
|
|
if FAutoScore then
|
|
|
Item.score := Item.score + 50;
|
|
|
end;
|
|
|
// <EFBFBD><EFBFBD><EFBFBD>ⷢ<EFBFBD><EFBFBD><EFBFBD>б<EFBFBD>
|
|
|
if FAutoScore or (Assigned(OutLog)) then
|
|
|
CheckFindURL(Item, Trim(Item.bookSourceUrl), Trim(Item.exploreUrl), '<EFBFBD><EFBFBD><EFBFBD><EFBFBD>', RaiseErr);
|
|
|
end;
|
|
|
|
|
|
if Assigned(OutLog) then
|
|
|
OutLog.Add(Format('<EFBFBD><EFBFBD>ʱ %d ms.', [GetTimestamp - T]));
|
|
|
end else begin
|
|
|
if Assigned(OutLog) then
|
|
|
OutLog.Add('<EFBFBD><EFBFBD>ԴURLδ<EFBFBD><EFBFBD><EFBFBD><EFBFBD>.');
|
|
|
raise Exception.Create('<EFBFBD><EFBFBD>ԴURL<EFBFBD><EFBFBD>Ч');
|
|
|
end;
|
|
|
finally
|
|
|
FreeAndNil(Json);
|
|
|
end;
|
|
|
end;
|
|
|
|
|
|
function TForm1.CheckItem(Item: TBookSourceItem): Boolean;
|
|
|
begin
|
|
|
Result := Assigned(Item) and (Item.bookSourceUrl <> '');
|
|
|
end;
|
|
|
|
|
|
function TForm1.CheckSaveState: Boolean;
|
|
|
var
|
|
|
LR: Integer;
|
|
|
begin
|
|
|
if FIsChange and (FCurIndex >= 0) and (FCurIndex < SrcList.Count) then begin
|
|
|
LR := MessageBox(Handle, '<EFBFBD><EFBFBD>Դ<EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ѿ<EFBFBD><EFBFBD>ģ<EFBFBD><EFBFBD>Ƿ棿', '<EFBFBD><EFBFBD>ʾ', 64 + MB_YESNOCANCEL);
|
|
|
if LR = IDCANCEL then begin
|
|
|
Result := False;
|
|
|
Exit;
|
|
|
end;
|
|
|
if LR = IDYES then
|
|
|
S1Click(S1);
|
|
|
end;
|
|
|
Result := True;
|
|
|
end;
|
|
|
|
|
|
procedure TForm1.CopySelected;
|
|
|
var
|
|
|
I: Integer;
|
|
|
Item: JSONObject;
|
|
|
begin
|
|
|
FBookCopyData.Clear;
|
|
|
for I := SrcList.Count - 1 downto 0 do begin
|
|
|
if SrcList.Selected[I] then begin
|
|
|
Item := FBookCopyData.AddChildObject;
|
|
|
Item.Assign(JSONObject(FFilterList[I]));
|
|
|
end;
|
|
|
end;
|
|
|
end;
|
|
|
|
|
|
procedure TForm1.CutSelectedt;
|
|
|
begin
|
|
|
CopySelected;
|
|
|
RemoveSelected;
|
|
|
end;
|
|
|
|
|
|
procedure TForm1.D1Click(Sender: TObject);
|
|
|
begin
|
|
|
RemoveSelected;
|
|
|
end;
|
|
|
|
|
|
procedure TForm1.DispLog;
|
|
|
begin
|
|
|
if FTaskStartTime > 0 then begin
|
|
|
if ProgressBar1.Visible then
|
|
|
StatusBar1.Panels[1].Text := Format('%s (%d/%d, %d%%) (<EFBFBD><EFBFBD>ʱ: %dms)',
|
|
|
[FStateMsg, ProgressBar1.Position, ProgressBar1.Max, Round(ProgressBar1.Position / ProgressBar1.Max * 100),
|
|
|
GetTimestamp - FTaskStartTime])
|
|
|
else
|
|
|
StatusBar1.Panels[1].Text := Format('%s (<EFBFBD><EFBFBD>ʱ: %dms)', [FStateMsg, GetTimestamp - FTaskStartTime])
|
|
|
end else
|
|
|
StatusBar1.Panels[1].Text := FStateMsg;
|
|
|
end;
|
|
|
|
|
|
procedure TForm1.DoCheckBookSourceItem(AJob: PJob);
|
|
|
var
|
|
|
Item: TBookSourceItem;
|
|
|
State: PProcessState;
|
|
|
V: Integer;
|
|
|
IsOK: Boolean;
|
|
|
Http: THttpClient;
|
|
|
Header: THttpHeaders;
|
|
|
begin
|
|
|
V := 0;
|
|
|
try
|
|
|
Http := THttpClient.Create(nil);
|
|
|
Http.ConnectionTimeOut := 30000;
|
|
|
Http.RecvTimeOut := 30000;
|
|
|
Http.AllowCookies := False;
|
|
|
Header := THttpHeaders.Create;
|
|
|
|
|
|
while (not AJob.IsTerminated) and (FWaitStop = 0) do begin
|
|
|
V := AtomicIncrement(FCurCheckIndex) - 1;
|
|
|
|
|
|
FLocker.Enter;
|
|
|
if (GetTimestamp - FCheckLastTime) > 100 then begin
|
|
|
FCheckLastTime := GetTimestamp;
|
|
|
New(State);
|
|
|
State.Min := 0;
|
|
|
State.Max := FCheckCount;
|
|
|
State.Value := FCheckFinish;
|
|
|
Workers.Post(DoUpdateProcess, State, True);
|
|
|
Sleep(10);
|
|
|
end;
|
|
|
FLocker.Leave;
|
|
|
|
|
|
if V < FCheckCount then begin
|
|
|
Item := TBookSourceItem(FBookSrcData.O[V]);
|
|
|
if not Assigned(Item) then Exit;
|
|
|
|
|
|
if (FAllSrc) or (FFilterList.IndexOf(Item) >= 0) then begin
|
|
|
|
|
|
try
|
|
|
IsOK := CheckBookSourceItem(Item, Http, Header);
|
|
|
except
|
|
|
IsOK := False;
|
|
|
end;
|
|
|
|
|
|
if IsOK then
|
|
|
Item.RemoveGroup('ʧЧ')
|
|
|
else
|
|
|
Item.AddGroup('ʧЧ');
|
|
|
|
|
|
Sleep(50);
|
|
|
end;
|
|
|
|
|
|
AtomicIncrement(FCheckFinish);
|
|
|
end else
|
|
|
Break;
|
|
|
|
|
|
end;
|
|
|
finally
|
|
|
|
|
|
if (V = FCheckCount) or (FWaitStop > 0) then begin
|
|
|
Sleep(100);
|
|
|
while not AJob.IsTerminated do begin
|
|
|
if (FCheckFinish >= FCheckCount) or (FWaitStop > 0) then
|
|
|
Break;
|
|
|
|
|
|
FLocker.Enter;
|
|
|
if (GetTimestamp - FCheckLastTime) > 1000 then begin
|
|
|
FCheckLastTime := GetTimestamp;
|
|
|
New(State);
|
|
|
State.Min := 0;
|
|
|
State.Max := FCheckCount;
|
|
|
State.Value := FCheckFinish;
|
|
|
Workers.Post(DoUpdateProcess, State, True);
|
|
|
Sleep(10);
|
|
|
end;
|
|
|
FLocker.Leave;
|
|
|
|
|
|
Sleep(100);
|
|
|
end;
|
|
|
Workers.Post(TaskFinish, nil, True);
|
|
|
end;
|
|
|
|
|
|
FreeAndNil(Http);
|
|
|
FreeAndNil(Header);
|
|
|
end;
|
|
|
end;
|
|
|
|
|
|
procedure TForm1.DoNotifyDataChange(AJob: PJob);
|
|
|
begin
|
|
|
NotifyListChange;
|
|
|
end;
|
|
|
|
|
|
procedure TForm1.DoUpdateProcess(AJob: PJob);
|
|
|
var
|
|
|
V: PProcessState;
|
|
|
begin
|
|
|
if not Assigned(Self) then Exit;
|
|
|
V := AJob.Data;
|
|
|
if V = nil then
|
|
|
ProgressBar1.Visible := False
|
|
|
else begin
|
|
|
ProgressBar1.Min := V.Min;
|
|
|
ProgressBar1.Max := V.Max;
|
|
|
ProgressBar1.Position := V.Value;
|
|
|
ProgressBar1.Visible := Button1.Tag <> 0;
|
|
|
if V.NeedFree then
|
|
|
Dispose(V);
|
|
|
end;
|
|
|
end;
|
|
|
|
|
|
procedure TForm1.E1Click(Sender: TObject);
|
|
|
begin
|
|
|
if SrcList.ItemIndex < 0 then Exit;
|
|
|
EditSource(TBookSourceItem(FFilterList[SrcList.ItemIndex]));
|
|
|
end;
|
|
|
|
|
|
procedure TForm1.E2Click(Sender: TObject);
|
|
|
var
|
|
|
FName: JSONString;
|
|
|
begin
|
|
|
if SaveDialog1.Execute(Handle) then begin
|
|
|
FName := SaveDialog1.FileName;
|
|
|
if ExtractFileExt(FName) = '' then
|
|
|
FName := FName + '.json';
|
|
|
FBookSrcData.SaveToFile(FName, 4, YxdStr.TTextEncoding.teUTF8, False);
|
|
|
end;
|
|
|
end;
|
|
|
|
|
|
procedure TForm1.EditDataChange(Sender: TObject);
|
|
|
begin
|
|
|
FIsChange := True;
|
|
|
end;
|
|
|
|
|
|
procedure TForm1.EditSource(Item: TBookSourceItem);
|
|
|
begin
|
|
|
ShowEditSource(Item,
|
|
|
procedure (Item: TBookSourceItem)
|
|
|
begin
|
|
|
if FBookSrcData.IndexOfObject(Item) < 0 then
|
|
|
FBookSrcData.Add(JSONObject(Item));
|
|
|
NotifyListChange;
|
|
|
if (FCurIndex >= 0) and (FCurIndex < FFilterList.Count) then begin
|
|
|
if TObject(FFilterList[FCurIndex]) = Item then begin
|
|
|
EditData.Text := TBookSourceItem(FFilterList[FCurIndex]).ToString(4);
|
|
|
FIsChange := False;
|
|
|
end;
|
|
|
end;
|
|
|
end
|
|
|
);
|
|
|
end;
|
|
|
|
|
|
procedure TForm1.ExportSelectedToFile;
|
|
|
var
|
|
|
FName: JSONString;
|
|
|
I: Integer;
|
|
|
Item: TBookSourceItem;
|
|
|
Items: JSONArray;
|
|
|
begin
|
|
|
if SrcList.SelCount = 0 then
|
|
|
Exit;
|
|
|
if SaveDialog1.Execute(Handle) then begin
|
|
|
FName := SaveDialog1.FileName;
|
|
|
if ExtractFileExt(FName) = '' then
|
|
|
FName := FName + '.json';
|
|
|
Items := JSONArray.Create;
|
|
|
try
|
|
|
for I := 0 to SrcList.Count - 1 do begin
|
|
|
if SrcList.Selected[I] then begin
|
|
|
Item := TBookSourceItem(JSONObject(FFilterList[I]));
|
|
|
if not Assigned(Item) then Continue;
|
|
|
Items.AddChildObject.Assign(Item);
|
|
|
end;
|
|
|
end;
|
|
|
Items.SaveToFile(FName, 4, YxdStr.TTextEncoding.teUTF8, False);
|
|
|
finally
|
|
|
Items.Free;
|
|
|
end;
|
|
|
end;
|
|
|
end;
|
|
|
|
|
|
procedure TForm1.F2Click(Sender: TObject);
|
|
|
begin
|
|
|
FindSource(InputBox('<EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Դ', '<EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ҫ<EFBFBD><EFBFBD><EFBFBD>ҵĹؼ<EFBFBD><EFBFBD><EFBFBD>', ''));
|
|
|
end;
|
|
|
|
|
|
procedure TForm1.FindSource(const FindStr: string);
|
|
|
var
|
|
|
I, J: Integer;
|
|
|
Item: TBookSourceItem;
|
|
|
begin
|
|
|
if FindStr = '' then Exit;
|
|
|
FLastFindSource := FindStr;
|
|
|
J := SrcList.ItemIndex + 1;
|
|
|
if J < 0 then J := 0;
|
|
|
for I := J to SrcList.Count - 1 do begin
|
|
|
Item := TBookSourceItem(JSONObject(FFilterList[I]));
|
|
|
if not Assigned(Item) then Continue;
|
|
|
J := Pos(FindStr, Item.bookSourceName);
|
|
|
if (Pos(FindStr, Item.bookSourceName) > 0) or (URL1.Checked and (Pos(FindStr, Item.bookSourceUrl) > 0)) then begin
|
|
|
SrcList.ClearSelection;
|
|
|
SrcList.ItemIndex := I;
|
|
|
SrcList.Selected[I] := True;
|
|
|
SrcList.ScrollBy(0, SrcList.ItemHeight * I + 1);
|
|
|
Exit;
|
|
|
end;
|
|
|
end;
|
|
|
LogD('<EFBFBD>Ҳ<EFBFBD><EFBFBD><EFBFBD> "' + FindStr + '" <EFBFBD><EFBFBD>');
|
|
|
end;
|
|
|
|
|
|
procedure TForm1.FormCreate(Sender: TObject);
|
|
|
begin
|
|
|
JsonNameAfterSpace := True;
|
|
|
JsonCaseSensitive := False;
|
|
|
FBookCopyData := JSONArray.Create;
|
|
|
FBookSrcData := JSONArray.Create;
|
|
|
FBookGroups := TStringHash.Create(997);
|
|
|
FFilterList := TList.Create;
|
|
|
FLocker := TCriticalSection.Create;
|
|
|
|
|
|
FWaitCheckBookSourceSingId := Workers.RegisterSignal('WaitCheckBookSource');
|
|
|
Workers.PostWait(WaitCheckBookSource, FWaitCheckBookSourceSingId);
|
|
|
end;
|
|
|
|
|
|
procedure TForm1.FormDestroy(Sender: TObject);
|
|
|
begin
|
|
|
FreeAndNil(FBookSrcData);
|
|
|
FreeAndNil(FBookGroups);
|
|
|
FreeAndNil(FFilterList);
|
|
|
FreeAndNil(FBookCopyData);
|
|
|
FreeAndNil(FLocker);
|
|
|
end;
|
|
|
|
|
|
procedure TForm1.FormShow(Sender: TObject);
|
|
|
begin
|
|
|
DragAcceptFiles(SrcList.Handle, True);
|
|
|
DragAcceptFiles(StaticText1.Handle, True);
|
|
|
|
|
|
OldListWndProc := SrcList.WindowProc;
|
|
|
OldTextWndProc := StaticText1.WindowProc;
|
|
|
SrcList.WindowProc := SrcListWndProc;
|
|
|
StaticText1.WindowProc := SrcListTextWndProc;
|
|
|
|
|
|
NotifyListChange;
|
|
|
end;
|
|
|
|
|
|
procedure TForm1.G1Click(Sender: TObject);
|
|
|
var
|
|
|
IsDX: Boolean;
|
|
|
begin
|
|
|
if FLastSortFlag <> 2 then begin
|
|
|
FLastSortFlag := 2;
|
|
|
IsDX := False;
|
|
|
end else begin
|
|
|
IsDX := True;
|
|
|
FLastSortFlag := 0;
|
|
|
end;
|
|
|
FBookSrcData.Sort(
|
|
|
function (A, B: Pointer): Integer
|
|
|
var
|
|
|
Item1: PJSONValue absolute A;
|
|
|
Item2: PJSONValue absolute B;
|
|
|
S1, S2: string;
|
|
|
begin
|
|
|
if (Item1.FType = Item2.FType) and (Item1.FType = jdtObject) and
|
|
|
(Item1.AsJsonObject <> nil) and (Item2.AsJsonObject <> nil)
|
|
|
then begin
|
|
|
S1 := TBookSourceItem(Item1.AsJsonObject).bookSourceGroup;
|
|
|
S2 := TBookSourceItem(Item2.AsJsonObject).bookSourceGroup;
|
|
|
if IsDX then
|
|
|
Result := CompareStr(S2, S1)
|
|
|
else
|
|
|
Result := CompareStr(S1, S2);
|
|
|
end else
|
|
|
Result := 0;
|
|
|
end
|
|
|
);
|
|
|
NotifyListChange(1);
|
|
|
end;
|
|
|
|
|
|
procedure TForm1.H2Click(Sender: TObject);
|
|
|
var
|
|
|
FindStr, NewStr: string;
|
|
|
I, Flag: Integer;
|
|
|
Item: TBookSourceItem;
|
|
|
begin
|
|
|
Flag := 0;
|
|
|
if ShowReplaceGroup(Self, '<EFBFBD>滻 - <EFBFBD><EFBFBD>Դ<EFBFBD><EFBFBD><EFBFBD><EFBFBD>', FindStr, NewStr, Flag) then begin
|
|
|
if (FindStr <> '') and (Flag = 0) then
|
|
|
Exit;
|
|
|
for I := 0 to FBookSrcData.Count - 1 do begin
|
|
|
Item := TBookSourceItem(FBookSrcData.O[I]);
|
|
|
if not Assigned(Item) then Continue;
|
|
|
if Flag = 0 then begin
|
|
|
Item.bookSourceGroup := StringReplace(Trim(Item.bookSourceGroup), FindStr, NewStr, [rfReplaceAll, rfIgnoreCase]);
|
|
|
end else begin
|
|
|
if NewStr = '' then
|
|
|
Item.RemoveGroup(FindStr)
|
|
|
else
|
|
|
Item.ReplaceGroup(FindStr, NewStr);
|
|
|
end;
|
|
|
end;
|
|
|
NotifyListChange();
|
|
|
end;
|
|
|
end;
|
|
|
|
|
|
procedure TForm1.I1Click(Sender: TObject);
|
|
|
var
|
|
|
Msg: string;
|
|
|
begin
|
|
|
Msg := Application.Title + sLineBreak + 'YangYxd <EFBFBD><EFBFBD>Ȩ<EFBFBD><EFBFBD><EFBFBD><EFBFBD> 2019';
|
|
|
MessageBox(Handle, PChar(Msg), '<EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>', 64);
|
|
|
end;
|
|
|
|
|
|
procedure TForm1.Log(const Msg: string);
|
|
|
begin
|
|
|
LogD(Msg);
|
|
|
FStateMsg := Msg;
|
|
|
DispLog();
|
|
|
end;
|
|
|
|
|
|
procedure TForm1.LogD(const Msg: string);
|
|
|
begin
|
|
|
edtLog.Lines.Add(Format('[%s] %s', [FormatDateTime('hh:mm:ss.zzz', Now), Msg]));
|
|
|
end;
|
|
|
|
|
|
procedure TForm1.N14Click(Sender: TObject);
|
|
|
begin
|
|
|
FindSource(FLastFindSource);
|
|
|
end;
|
|
|
|
|
|
procedure TForm1.N15Click(Sender: TObject);
|
|
|
var
|
|
|
I: Integer;
|
|
|
GName: string;
|
|
|
Item: TBookSourceItem;
|
|
|
begin
|
|
|
GName := InputBox('<EFBFBD><EFBFBD><EFBFBD>ӷ<EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>', '<EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>', '<EFBFBD><EFBFBD><EFBFBD><EFBFBD>');
|
|
|
if GName = '' then Exit;
|
|
|
|
|
|
for I := 0 to SrcList.Count - 1 do begin
|
|
|
if SrcList.Selected[I] then begin
|
|
|
Item := TBookSourceItem(JSONObject(FFilterList[I]));
|
|
|
if not Assigned(Item) then Continue;
|
|
|
Item.AddGroup(GName);
|
|
|
end;
|
|
|
end;
|
|
|
NotifyListChange;
|
|
|
end;
|
|
|
|
|
|
procedure TForm1.N17Click(Sender: TObject);
|
|
|
var
|
|
|
I: Integer;
|
|
|
GName: string;
|
|
|
Item: TBookSourceItem;
|
|
|
begin
|
|
|
GName := InputBox('<EFBFBD><EFBFBD><EFBFBD>ӷ<EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>', '<EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>', '<EFBFBD><EFBFBD><EFBFBD><EFBFBD>');
|
|
|
if GName = '' then Exit;
|
|
|
|
|
|
for I := 0 to SrcList.Count - 1 do begin
|
|
|
if SrcList.Selected[I] then begin
|
|
|
Item := TBookSourceItem(JSONObject(FFilterList[I]));
|
|
|
if not Assigned(Item) then Continue;
|
|
|
Item.RemoveGroup(GName);
|
|
|
end;
|
|
|
end;
|
|
|
NotifyListChange;
|
|
|
end;
|
|
|
|
|
|
procedure TForm1.N18Click(Sender: TObject);
|
|
|
begin
|
|
|
ExportSelectedToFile;
|
|
|
end;
|
|
|
|
|
|
procedure TForm1.N7Click(Sender: TObject);
|
|
|
var
|
|
|
Item: TBookSourceItem;
|
|
|
begin
|
|
|
Item := TBookSourceItem(JSONObject.Create);
|
|
|
EditSource(Item);
|
|
|
end;
|
|
|
|
|
|
procedure TForm1.NotifyListChange(Flag: Integer);
|
|
|
var
|
|
|
I, J: Integer;
|
|
|
Key: string;
|
|
|
Item: TBookSourceItem;
|
|
|
|
|
|
function EqualsBookType(const ABookType: string): Boolean;
|
|
|
begin
|
|
|
Result := (FBookType = '') or (FBookType = UpperCase(ABookType)) or
|
|
|
((FBookType = 'TEXT') and (ABookType = ''));
|
|
|
end;
|
|
|
|
|
|
begin
|
|
|
J := FCurIndex;
|
|
|
|
|
|
if Flag = 0 then begin
|
|
|
for I := 0 to FBookSrcData.Count - 1 do
|
|
|
UpdateBookGroup(TBookSourceItem(FBookSrcData.O[I]));
|
|
|
bookGroupList.Items.Clear;
|
|
|
bookGroupList.Items.Add('<EFBFBD><EFBFBD><EFBFBD><EFBFBD>');
|
|
|
bookGroupList.Items.Add('ʧЧ');
|
|
|
FBookGroups.GetKeyList(bookGroupList.Items);
|
|
|
end;
|
|
|
|
|
|
FFilterList.Clear;
|
|
|
Key := LowerCase(bookGroupList.Text);
|
|
|
if Key <> '' then begin
|
|
|
for I := 0 to FBookSrcData.Count - 1 do begin
|
|
|
Item := TBookSourceItem(FBookSrcData.O[I]);
|
|
|
if Item.bookSourceType = 0 then begin // EqualsBookType(Item.bookSourceType)
|
|
|
if (Pos(Key, Item.bookSourceGroup) > 0) or (Pos(Key, Item.bookSourceName) > 0) then
|
|
|
FFilterList.Add(Item);
|
|
|
end;
|
|
|
end;
|
|
|
end else begin
|
|
|
for I := 0 to FBookSrcData.Count - 1 do begin
|
|
|
Item := TBookSourceItem(FBookSrcData.O[I]);
|
|
|
if Item.bookSourceType = 0 then // EqualsBookType(Item.bookSourceType)
|
|
|
FFilterList.Add(Item);
|
|
|
end;
|
|
|
end;
|
|
|
|
|
|
SrcList.Count := FFilterList.Count;
|
|
|
StaticText1.Visible := SrcList.Count = 0;
|
|
|
if (J < SrcList.Count) and (J >= 0) then begin
|
|
|
SrcList.ClearSelection;
|
|
|
SrcList.ItemIndex := J;
|
|
|
SrcList.Selected[J] := True;
|
|
|
SrcListClick(SrcList);
|
|
|
end;
|
|
|
|
|
|
SrcList.ShowHint := SrcList.Count = 0;
|
|
|
StatusBar1.Panels[0].Text := Format('<EFBFBD><EFBFBD>Դ<EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>%d<EFBFBD><EFBFBD>, <EFBFBD><EFBFBD>ǰ: %d<EFBFBD><EFBFBD>', [FBookSrcData.Count, FFilterList.Count]);
|
|
|
end;
|
|
|
|
|
|
procedure TForm1.O1Click(Sender: TObject);
|
|
|
begin
|
|
|
OpenDialog1.Title := '<EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Դ<EFBFBD>ļ<EFBFBD>';
|
|
|
if OpenDialog1.Execute(Handle) then begin
|
|
|
FBookSrcData.Clear;
|
|
|
AddSrcFile(OpenDialog1.FileName);
|
|
|
end;
|
|
|
end;
|
|
|
|
|
|
procedure TForm1.O2Click(Sender: TObject);
|
|
|
var
|
|
|
IsDX: Boolean;
|
|
|
begin
|
|
|
if FLastSortFlag <> 4 then begin
|
|
|
FLastSortFlag := 4;
|
|
|
IsDX := False;
|
|
|
end else begin
|
|
|
IsDX := True;
|
|
|
FLastSortFlag := 0;
|
|
|
end;
|
|
|
FBookSrcData.Sort(
|
|
|
function (A, B: Pointer): Integer
|
|
|
var
|
|
|
Item1: PJSONValue absolute A;
|
|
|
Item2: PJSONValue absolute B;
|
|
|
begin
|
|
|
if (Item1.FType = Item2.FType) and (Item1.FType = jdtObject) and
|
|
|
(Item1.AsJsonObject <> nil) and (Item2.AsJsonObject <> nil)
|
|
|
then begin
|
|
|
if IsDX then
|
|
|
Result := TBookSourceItem(Item1.AsJsonObject).score - TBookSourceItem(Item2.AsJsonObject).score
|
|
|
else
|
|
|
Result := TBookSourceItem(Item2.AsJsonObject).score - TBookSourceItem(Item1.AsJsonObject).score;
|
|
|
end else
|
|
|
Result := 0;
|
|
|
end
|
|
|
);
|
|
|
NotifyListChange(1);
|
|
|
end;
|
|
|
|
|
|
procedure TForm1.P1Click(Sender: TObject);
|
|
|
begin
|
|
|
EditData.PasteFromClipboard;
|
|
|
end;
|
|
|
|
|
|
procedure TForm1.P2Click(Sender: TObject);
|
|
|
begin
|
|
|
Paste;
|
|
|
end;
|
|
|
|
|
|
procedure TForm1.Paste;
|
|
|
var
|
|
|
I: Integer;
|
|
|
begin
|
|
|
for I := 0 to FBookCopyData.Count - 1 do
|
|
|
FBookSrcData.AddChildObject.Assign(FBookCopyData.O[I]);
|
|
|
NotifyListChange();
|
|
|
end;
|
|
|
|
|
|
procedure TForm1.PopupMenu1Popup(Sender: TObject);
|
|
|
begin
|
|
|
C4.Enabled := SrcList.SelCount > 0;
|
|
|
X2.Enabled := C4.Enabled;
|
|
|
C3.Enabled := C4.Enabled;
|
|
|
E1.Enabled := C4.Enabled;
|
|
|
D1.Enabled := C4.Enabled;
|
|
|
P2.Enabled := FBookCopyData.Count > 0;
|
|
|
N14.Enabled := FLastFindSource <> '';
|
|
|
end;
|
|
|
|
|
|
procedure TForm1.PopupMenu2Popup(Sender: TObject);
|
|
|
begin
|
|
|
S1.Enabled := SrcList.ItemIndex >= 0;
|
|
|
P1.Enabled := EditData.CanPaste;
|
|
|
X1.Enabled := EditData.SelLength > 0;
|
|
|
C2.Enabled := X1.Enabled;
|
|
|
R1.Enabled := EditData.CanUndo;
|
|
|
Z1.Enabled := EditData.CanRedo;
|
|
|
W1.Checked := EditData.WordWrap;
|
|
|
end;
|
|
|
|
|
|
procedure TForm1.R1Click(Sender: TObject);
|
|
|
begin
|
|
|
EditData.Undo;
|
|
|
end;
|
|
|
|
|
|
procedure TForm1.R2Click(Sender: TObject);
|
|
|
begin
|
|
|
ShellExecute(0, 'OPEN', PChar('https://github.com/yangyxd/MyBookshelf'), nil, nil, SW_SHOWMAXIMIZED)
|
|
|
end;
|
|
|
|
|
|
procedure TForm1.RadioButton1Click(Sender: TObject);
|
|
|
begin
|
|
|
BookType := '';
|
|
|
end;
|
|
|
|
|
|
procedure TForm1.RadioButton2Click(Sender: TObject);
|
|
|
begin
|
|
|
BookType := 'TEXT';
|
|
|
end;
|
|
|
|
|
|
procedure TForm1.RadioButton3Click(Sender: TObject);
|
|
|
begin
|
|
|
BookType := 'AUDIO';
|
|
|
end;
|
|
|
|
|
|
procedure TForm1.RadioButton4Click(Sender: TObject);
|
|
|
begin
|
|
|
BookType := 'IMAGE';
|
|
|
end;
|
|
|
|
|
|
procedure TForm1.RemoveRepeat(AJob: PJob);
|
|
|
var
|
|
|
CheckName: Boolean;
|
|
|
|
|
|
function Equals(A, B: TBookSourceItem): Boolean;
|
|
|
begin
|
|
|
Result :=
|
|
|
(LowerCase(A.bookSourceUrl) = LowerCase(B.bookSourceUrl)) and
|
|
|
(LowerCase(A.loginUrl) = LowerCase(B.loginUrl)) and
|
|
|
(LowerCase(A.header) = LowerCase(B.header)) and
|
|
|
(LowerCase(A.exploreUrl) = LowerCase(B.exploreUrl)) and
|
|
|
(LowerCase(A.ruleContent_content) = LowerCase(B.ruleContent_content)) and
|
|
|
(LowerCase(A.ruleContent_nextContentUrl) = LowerCase(B.ruleContent_nextContentUrl)) and
|
|
|
(LowerCase(A.ruleSearch_kind) = LowerCase(B.ruleSearch_kind)) and
|
|
|
(LowerCase(A.ruleSearch_lastChapter) = LowerCase(B.ruleSearch_lastChapter)) and
|
|
|
(LowerCase(A.ruleSearch_name) = LowerCase(B.ruleSearch_name)) and
|
|
|
(A.bookSourceType = B.bookSourceType) and
|
|
|
(LowerCase(A.ruleSearch_bookUrl) = LowerCase(B.ruleSearch_bookUrl)) and
|
|
|
(LowerCase(A.ruleSearch_coverUrl) = LowerCase(B.ruleSearch_coverUrl)) and
|
|
|
(LowerCase(A.ruleSearch_intro) = LowerCase(B.ruleSearch_intro)) and
|
|
|
(LowerCase(A.bookUrlPattern) = LowerCase(B.bookUrlPattern)) and
|
|
|
(LowerCase(A.ruleToc_chapterName) = LowerCase(B.ruleToc_chapterName)) and
|
|
|
(LowerCase(A.ruleToc_chapterList) = LowerCase(B.ruleToc_chapterList)) and
|
|
|
(LowerCase(A.ruleToc_chapterUrl) = LowerCase(B.ruleToc_chapterUrl)) and
|
|
|
(LowerCase(A.ruleToc_nextTocUrl) = LowerCase(B.ruleToc_nextTocUrl)) and
|
|
|
(LowerCase(A.ruleContent_webJs) = LowerCase(B.ruleContent_webJs)) and
|
|
|
(LowerCase(A.ruleBookInfo_author) = LowerCase(B.ruleBookInfo_author)) and
|
|
|
(LowerCase(A.ruleBookInfo_name) = LowerCase(B.ruleBookInfo_name)) and
|
|
|
(LowerCase(A.ruleExplore_bookList) = LowerCase(B.ruleExplore_bookList)) and
|
|
|
(LowerCase(A.ruleExplore_name) = LowerCase(B.ruleExplore_name)) and
|
|
|
(LowerCase(A.ruleExplore_lastChapter) = LowerCase(B.ruleExplore_lastChapter));
|
|
|
if not CheckName then
|
|
|
Result := Result and
|
|
|
(LowerCase(A.bookSourceName) = LowerCase(B.bookSourceName)) and
|
|
|
(LowerCase(A.bookSourceGroup) = LowerCase(B.bookSourceGroup));
|
|
|
end;
|
|
|
|
|
|
var
|
|
|
I, J, LastCount, ST: Integer;
|
|
|
Item: TBookSourceItem;
|
|
|
T: TProcessState;
|
|
|
State: PProcessState;
|
|
|
List: TList;
|
|
|
begin
|
|
|
I := 0;
|
|
|
LastCount := FBookSrcData.Count;
|
|
|
CheckName := Boolean(Integer(AJob.Data));
|
|
|
|
|
|
T.STime := GetTimestamp;
|
|
|
T.Min := 0;
|
|
|
T.Value := 0;
|
|
|
ST := 1000;
|
|
|
|
|
|
try
|
|
|
|
|
|
while I < FBookSrcData.Count do begin
|
|
|
Item := TBookSourceItem(FBookSrcData.O[I]);
|
|
|
Inc(I);
|
|
|
|
|
|
if (not FAllSrc) and (FFilterList.IndexOf(Item) < 0) then
|
|
|
Continue;
|
|
|
|
|
|
if FAutoDel then begin
|
|
|
for J := FBookSrcData.Count - 1 downto I do begin
|
|
|
if Equals(Item, TBookSourceItem(FBookSrcData.O[J])) then
|
|
|
FBookSrcData.Remove(J);
|
|
|
end;
|
|
|
end;
|
|
|
|
|
|
if FAutoFind then begin
|
|
|
if Item.exploreUrl <> '' then
|
|
|
Item.AddGroup('<EFBFBD><EFBFBD><EFBFBD><EFBFBD>')
|
|
|
else
|
|
|
Item.RemoveGroup('<EFBFBD><EFBFBD><EFBFBD><EFBFBD>');
|
|
|
end;
|
|
|
|
|
|
if AJob.IsTerminated or (FWaitStop > 0) then
|
|
|
Break;
|
|
|
if GetTimestamp - T.STime > ST then begin
|
|
|
ST := 200;
|
|
|
T.Value := I;
|
|
|
T.Max := FBookSrcData.Count;
|
|
|
New(State);
|
|
|
State^ := T;
|
|
|
State.NeedFree := True;
|
|
|
Workers.Post(DoUpdateProcess, State, True);
|
|
|
end;
|
|
|
end;
|
|
|
|
|
|
finally
|
|
|
if LastCount <> FBookSrcData.Count then
|
|
|
Workers.Post(DoNotifyDataChange, nil, True);
|
|
|
Sleep(100);
|
|
|
Workers.Post(TaskFinish, nil, True);
|
|
|
end;
|
|
|
end;
|
|
|
|
|
|
procedure TForm1.RemoveSelected;
|
|
|
var
|
|
|
I, V: Integer;
|
|
|
begin
|
|
|
for I := SrcList.Count - 1 downto 0 do begin
|
|
|
if SrcList.Selected[I] then begin
|
|
|
V := FBookSrcData.IndexOfObject(JSONObject(FFilterList[I]));
|
|
|
if V >= 0 then
|
|
|
FBookSrcData.Remove(V);
|
|
|
end;
|
|
|
end;
|
|
|
NotifyListChange;
|
|
|
end;
|
|
|
|
|
|
procedure TForm1.S1Click(Sender: TObject);
|
|
|
var
|
|
|
S: string;
|
|
|
Item: TBookSourceItem;
|
|
|
begin
|
|
|
if (FCurIndex < 0) or (FCurIndex >= SrcList.Count) then Exit;
|
|
|
Item := TBookSourceItem(FFilterList[FCurIndex]);
|
|
|
if not Assigned(Item) then Exit;
|
|
|
try
|
|
|
FIsChange := False;
|
|
|
S := Item.ToString();
|
|
|
Item.Parse(EditData.Text);
|
|
|
if not CheckItem(Item) then
|
|
|
Item.Parse(S);
|
|
|
finally
|
|
|
NotifyListChange;
|
|
|
end;
|
|
|
end;
|
|
|
|
|
|
procedure TForm1.S2Click(Sender: TObject);
|
|
|
var
|
|
|
IsDX: Boolean;
|
|
|
begin
|
|
|
if FLastSortFlag <> 1 then begin
|
|
|
FLastSortFlag := 1;
|
|
|
IsDX := False;
|
|
|
end else begin
|
|
|
IsDX := True;
|
|
|
FLastSortFlag := 0;
|
|
|
end;
|
|
|
FBookSrcData.Sort(
|
|
|
function (A, B: Pointer): Integer
|
|
|
var
|
|
|
Item1: PJSONValue absolute A;
|
|
|
Item2: PJSONValue absolute B;
|
|
|
S1, S2: string;
|
|
|
begin
|
|
|
if (Item1.FType = Item2.FType) and (Item1.FType = jdtObject) and
|
|
|
(Item1.AsJsonObject <> nil) and (Item2.AsJsonObject <> nil)
|
|
|
then begin
|
|
|
S1 := TBookSourceItem(Item1.AsJsonObject).bookSourceName;
|
|
|
S2 := TBookSourceItem(Item2.AsJsonObject).bookSourceName;
|
|
|
if IsDX then
|
|
|
Result := CompareStr(S2, S1)
|
|
|
else
|
|
|
Result := CompareStr(S1, S2);
|
|
|
end else
|
|
|
Result := 0;
|
|
|
end
|
|
|
);
|
|
|
NotifyListChange(1);
|
|
|
end;
|
|
|
|
|
|
procedure TForm1.S3Click(Sender: TObject);
|
|
|
begin
|
|
|
ExportSelectedToFile();
|
|
|
end;
|
|
|
|
|
|
procedure TForm1.SetBookType(const Value: string);
|
|
|
begin
|
|
|
if UpperCase(FBookType) <> UpperCase(Value) then begin
|
|
|
FBookType := UpperCase(Value);
|
|
|
NotifyListChange();
|
|
|
end;
|
|
|
end;
|
|
|
|
|
|
procedure TForm1.SpeedButton1Click(Sender: TObject);
|
|
|
begin
|
|
|
edtLog.Lines.Clear;
|
|
|
end;
|
|
|
|
|
|
procedure TForm1.SrcListClick(Sender: TObject);
|
|
|
begin
|
|
|
if SrcList.ItemIndex < 0 then Exit;
|
|
|
if not CheckSaveState then Exit;
|
|
|
FCurIndex := SrcList.ItemIndex;
|
|
|
EditData.Text := TBookSourceItem(FFilterList[FCurIndex]).ToString(4);
|
|
|
FIsChange := False;
|
|
|
end;
|
|
|
|
|
|
procedure TForm1.SrcListData(Control: TWinControl; Index: Integer;
|
|
|
var Data: string);
|
|
|
var
|
|
|
Item: TBookSourceItem;
|
|
|
begin
|
|
|
if Index < FBookSrcData.Count then begin
|
|
|
Item := TBookSourceItem(FFilterList[index]);
|
|
|
Data := Format('<EFBFBD><EFBFBD>%s<EFBFBD><EFBFBD>%s', [Item.bookSourceGroup, Item.bookSourceName]);
|
|
|
end else
|
|
|
Data := '';
|
|
|
end;
|
|
|
|
|
|
procedure TForm1.SrcListDblClick(Sender: TObject);
|
|
|
begin
|
|
|
E1Click(E1);
|
|
|
end;
|
|
|
|
|
|
procedure TForm1.SrcListKeyDown(Sender: TObject; var Key: Word;
|
|
|
Shift: TShiftState);
|
|
|
|
|
|
procedure PasteItems();
|
|
|
var
|
|
|
pGlobal : Thandle;
|
|
|
begin
|
|
|
OpenClipboard(Handle);
|
|
|
try
|
|
|
pGlobal := GetClipboardData(CF_HDROP); //<EFBFBD><EFBFBD>ȡ<EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ļ<EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
|
|
if pGlobal > 0 then
|
|
|
AddSrcFiles(pGlobal);
|
|
|
finally
|
|
|
CloseClipboard;
|
|
|
end;
|
|
|
end;
|
|
|
|
|
|
begin
|
|
|
if Key = VK_DELETE then begin
|
|
|
RemoveSelected();
|
|
|
end else if Key = Ord('V') then begin // ճ<EFBFBD><EFBFBD>
|
|
|
PasteItems();
|
|
|
end;
|
|
|
end;
|
|
|
|
|
|
procedure TForm1.SrcListTextWndProc(var Message: TMessage);
|
|
|
begin
|
|
|
if Message.Msg = WM_DROPFILES then
|
|
|
WMDropFiles(TWMDropFiles(Message))
|
|
|
else
|
|
|
OldTextWndProc(Message);
|
|
|
end;
|
|
|
|
|
|
procedure TForm1.SrcListWndProc(var Message: TMessage);
|
|
|
begin
|
|
|
if Message.Msg = WM_DROPFILES then
|
|
|
WMDropFiles(TWMDropFiles(Message))
|
|
|
else
|
|
|
OldListWndProc(Message);
|
|
|
end;
|
|
|
|
|
|
procedure TForm1.T1Click(Sender: TObject);
|
|
|
var
|
|
|
Item: TBookSourceItem;
|
|
|
begin
|
|
|
Item := TBookSourceItem(JSONObject.Create);
|
|
|
try
|
|
|
Item.Parse(EditData.Text);
|
|
|
if CheckBookSourceItem(Item, True, edtLog.Lines) then
|
|
|
LogD('<EFBFBD><EFBFBD>ϲ, <EFBFBD><EFBFBD><EFBFBD><EFBFBD>ͨ<EFBFBD><EFBFBD>!')
|
|
|
else
|
|
|
LogD('<EFBFBD><EFBFBD>Դ<EFBFBD>쳣!');
|
|
|
EditData.Text := Item.ToString(4);
|
|
|
finally
|
|
|
FreeAndNil(Item);
|
|
|
end;
|
|
|
end;
|
|
|
|
|
|
procedure TForm1.TaskFinish(AJob: PJob);
|
|
|
var
|
|
|
I: Integer;
|
|
|
begin
|
|
|
I := AtomicDecrement(FTaskRef);
|
|
|
if (I <= 0) or (FWaitStop > 0) then begin
|
|
|
if (I = 0) and Assigned(Self) and (not (csDestroying in ComponentState)) then begin
|
|
|
NotifyListChange();
|
|
|
Button1Click(Button1);
|
|
|
end;
|
|
|
end else if not (csDestroying in ComponentState) then begin
|
|
|
Log('<EFBFBD><EFBFBD><EFBFBD><EFBFBD>У<EFBFBD><EFBFBD><EFBFBD><EFBFBD>Դ...');
|
|
|
Workers.SendSignal(FWaitCheckBookSourceSingId);
|
|
|
end;
|
|
|
end;
|
|
|
|
|
|
procedure TForm1.Timer1Timer(Sender: TObject);
|
|
|
begin
|
|
|
DispLog;
|
|
|
end;
|
|
|
|
|
|
procedure TForm1.U1Click(Sender: TObject);
|
|
|
var
|
|
|
Item: TBookSourceItem;
|
|
|
begin
|
|
|
Item := TBookSourceItem(JSONObject.Create);
|
|
|
try
|
|
|
Item.Parse(EditData.Text);
|
|
|
Item.lastUpdateTime := GetCurJavaDateTime;
|
|
|
finally
|
|
|
FreeAndNil(Item);
|
|
|
end;
|
|
|
end;
|
|
|
|
|
|
procedure TForm1.UpdateBookGroup(Item: TBookSourceItem);
|
|
|
var
|
|
|
J: Integer;
|
|
|
ARef: Number;
|
|
|
ABookGroup: TArray<string>;
|
|
|
AGroup: string;
|
|
|
begin
|
|
|
ABookGroup := Item.GetGroupList;
|
|
|
|
|
|
for J := 0 to High(ABookGroup) do begin
|
|
|
ARef := 0;
|
|
|
AGroup := Trim(ABookGroup[J]);
|
|
|
FBookGroups.TryGetValue(AGroup, ARef);
|
|
|
Inc(ARef);
|
|
|
FBookGroups.AddOrUpdate(AGroup, ARef);
|
|
|
end;
|
|
|
end;
|
|
|
|
|
|
procedure TForm1.URL1Click(Sender: TObject);
|
|
|
begin
|
|
|
TMenuItem(Sender).Checked := not TMenuItem(Sender).Checked;
|
|
|
end;
|
|
|
|
|
|
procedure TForm1.W1Click(Sender: TObject);
|
|
|
begin
|
|
|
EditData.WordWrap := not W1.Checked;
|
|
|
end;
|
|
|
|
|
|
procedure TForm1.W2Click(Sender: TObject);
|
|
|
begin
|
|
|
ShellExecute(0, 'OPEN', PChar('http://www.cnblogs.com/yangyxd/'), nil, nil, SW_SHOWMAXIMIZED)
|
|
|
end;
|
|
|
|
|
|
procedure TForm1.W3Click(Sender: TObject);
|
|
|
var
|
|
|
IsDX: Boolean;
|
|
|
begin
|
|
|
if FLastSortFlag <> 3 then begin
|
|
|
FLastSortFlag := 3;
|
|
|
IsDX := False;
|
|
|
end else begin
|
|
|
IsDX := True;
|
|
|
FLastSortFlag := 0;
|
|
|
end;
|
|
|
FBookSrcData.Sort(
|
|
|
function (A, B: Pointer): Integer
|
|
|
var
|
|
|
Item1: PJSONValue absolute A;
|
|
|
Item2: PJSONValue absolute B;
|
|
|
begin
|
|
|
if (Item1.FType = Item2.FType) and (Item1.FType = jdtObject) and
|
|
|
(Item1.AsJsonObject <> nil) and (Item2.AsJsonObject <> nil)
|
|
|
then begin
|
|
|
if IsDX then
|
|
|
Result := TBookSourceItem(Item1.AsJsonObject).weight - TBookSourceItem(Item2.AsJsonObject).weight
|
|
|
else
|
|
|
Result := TBookSourceItem(Item2.AsJsonObject).weight - TBookSourceItem(Item1.AsJsonObject).weight;
|
|
|
end else
|
|
|
Result := 0;
|
|
|
end
|
|
|
);
|
|
|
NotifyListChange(1);
|
|
|
end;
|
|
|
|
|
|
procedure TForm1.WaitCheckBookSource(AJob: PJob);
|
|
|
var
|
|
|
I, J: Integer;
|
|
|
begin
|
|
|
if FBookSrcData.Count > 0 then begin
|
|
|
FCheckCount := FBookSrcData.Count;
|
|
|
FCurCheckIndex := 0;
|
|
|
FCheckFinish := 0;
|
|
|
J := Min(FBookSrcData.Count, FMaxWorkers);
|
|
|
for I := 0 to J - 1 do begin
|
|
|
if AJob.IsTerminated then
|
|
|
Break;
|
|
|
Workers.Post(DoCheckBookSourceItem, nil);
|
|
|
end;
|
|
|
end else
|
|
|
Workers.Post(TaskFinish, nil, True);
|
|
|
end;
|
|
|
|
|
|
procedure TForm1.WMDropFiles(var Msg: TWMDropFiles);
|
|
|
begin
|
|
|
AddSrcFiles(Msg.Drop);
|
|
|
end;
|
|
|
|
|
|
procedure TForm1.X1Click(Sender: TObject);
|
|
|
begin
|
|
|
EditData.CopyToClipboard;
|
|
|
EditData.SelText := '';
|
|
|
end;
|
|
|
|
|
|
procedure TForm1.X2Click(Sender: TObject);
|
|
|
begin
|
|
|
CutSelectedt;
|
|
|
end;
|
|
|
|
|
|
procedure TForm1.Z1Click(Sender: TObject);
|
|
|
begin
|
|
|
EditData.Redo;
|
|
|
end;
|
|
|
|
|
|
end.
|
|
|
|