root/trunk/ImportImpl/unit_ImportFB2ThreadBase.pas

Show revision log
 
457465
1
{ ****************************************************************************** }
1
(* *****************************************************************************
2
{ }
2
  *
3
{ MyHomeLib }
3
  * MyHomeLib
4
{ }
4
  *
5
{ Version 0.9 }
5
  * Copyright (C) 2008-2010 Aleksey Penkov
6
{ 20.08.2008 }
6
  *
7
{ Copyright (c) Aleksey Penkov  alex.penkov@gmail.com }
7
  * Created             22.02.2010
8
{ }
8
  * Description
9
{ @author Nick Rymanov nrymanov@gmail.com }
9
  * Author(s)           Nick Rymanov    nrymanov@gmail.com
10
{ }
10
  *                     Aleksey Penkov  alex.penkov@gmail.com
11
{ ****************************************************************************** }
11
  *
12
  * History



13
  * NickR 02.03.2010    Код переформатирован
  *



14
  ****************************************************************************** *)



12
15



13
unit unit_ImportFB2ThreadBase;
16
unit unit_ImportFB2ThreadBase;



14
17


...
...
28
  TImportFB2ThreadBase = class(TWorker)
32
  TImportFB2ThreadBase = class(TWorker)



29
  private
33
  private



30
    FFullNameSearch: Boolean;
34
    FFullNameSearch: Boolean;



35



31
  protected
36
  protected



32
    FDBFileName: string;
37
    FDBFileName: string;



33
    FLibrary: TMHLLibrary;
38
    FLibrary: TMHLLibrary;


...
...
48
53



49
    function GetNewFolder(Folder: string; R: TBookRecord): string;
54
    function GetNewFolder(Folder: string; R: TBookRecord): string;



50
    function GetNewFileName(FileName: string; R: TBookRecord): string;
55
    function GetNewFileName(FileName: string; R: TBookRecord): string;



56



51
  protected
57
  protected



52
    procedure WorkFunction; override;
58
    procedure WorkFunction; override;



53
    procedure ProcessFileList; virtual; abstract;
59
    procedure ProcessFileList; virtual; abstract;



54
    procedure GetBookInfo(book: IXMLFictionBook; var R: TBookRecord);
60
    procedure GetBookInfo(book: IXMLFictionBook; var R: TBookRecord);



55
    procedure SortFiles(var R: TBookRecord); virtual;
61
    procedure SortFiles(var R: TBookRecord); virtual;



62



56
  public
63
  public



57
    property DBFileName: string read FDBFileName write FDBFileName;
64
    property DBFileName: string read FDBFileName write FDBFileName;



58
    property TargetExt: string write FTargetExt;
65
    property TargetExt: string write FTargetExt;


...
...
67
  unit_Settings,
74
  unit_Settings,



68
  unit_Consts,
75
  unit_Consts,



69
  Dialogs;
76
  Dialogs;



77



70
{ TImportFB2Thread }
78
{ TImportFB2Thread }



71
79



72
procedure TImportFB2ThreadBase.AddFile2List
80
procedure TImportFB2ThreadBase.AddFile2List(Sender: TObject; const F: TSearchRec);



73
  (Sender: TObject; const F: TSearchRec);



74
var
81
var



75
  FileName: string;
82
  FileName: string;



76
begin
83
begin


...
...
82
        FileName := FFilesList.LastDir + F.Name
89
        FileName := FFilesList.LastDir + F.Name



83
      else
90
      else



84
        FileName := ExtractRelativePath(FRootPath, FFilesList.LastDir) + F.Name;
91
        FileName := ExtractRelativePath(FRootPath, FFilesList.LastDir) + F.Name;



85
      if not FLibrary.CheckFileInCollection(FileName, FFullNameSearch,
92
      if not FLibrary.CheckFileInCollection(FileName, FFullNameSearch, FZipFolder) then



86
        FZipFolder) then



87
        FFiles.Add(FFilesList.LastDir + F.Name);
93
        FFiles.Add(FFilesList.LastDir + F.Name);



88
    end;
94
    end;



89
  end;
95
  end;


...
...
95
101



96
  if Canceled then
102
  if Canceled then



97
    Abort;
103
    Abort;



98



99
end;
104
end;



100
105



101
procedure TImportFB2ThreadBase.GetBookInfo(book: IXMLFictionBook;
106
procedure TImportFB2ThreadBase.GetBookInfo(book: IXMLFictionBook; var R: TBookRecord);



102
  var R: TBookRecord);



103
var
107
var



104
  i: integer;
108
  i: Integer;



105
begin
109
begin



106
  with book.Description.Titleinfo do
110
  with book.Description.Titleinfo do



107
  begin
111
  begin



108
    for i := 0 to Author.Count - 1 do
112
    for i := 0 to Author.Count - 1 do



109
      R.AddAuthor(Author[i].Lastname.Text, Author[i].Firstname.Text,
113
      R.AddAuthor(Author[i].Lastname.Text, Author[i].Firstname.Text, Author[i].MiddleName.Text);



110
        Author[i].MiddleName.Text);



111
114



112
    if Booktitle.IsTextElement then
115
    if Booktitle.IsTextElement then



113
      R.Title := Booktitle.Text;
116
      R.Title := Booktitle.Text;


...
...
131
      if Annotation.P.Items[i].IsTextElement then
134
      if Annotation.P.Items[i].IsTextElement then



132
        R.Annotation := R.Annotation + #10#13 + Annotation.P.Items[i].OnlyText;
135
        R.Annotation := R.Annotation + #10#13 + Annotation.P.Items[i].OnlyText;



133
136



134
    R.RootGenre:= Trim(FLibrary.GetTopGenreAlias(R.Genres[0].GenreFb2Code));
137
    R.RootGenre.Alias := Trim(FLibrary.GetTopGenreAlias(R.Genres[0].GenreFb2Code));



135
  end;
138
  end;



136
end;
139
end;



137
140



138
procedure TImportFB2ThreadBase.ShowCurrentDir
141
procedure TImportFB2ThreadBase.ShowCurrentDir(Sender: TObject; const Dir: string);



139
  (Sender: TObject; const Dir: string);



140
begin
142
begin



141
  SetComment(Format('Сканируем %s', [Dir]));
143
  SetComment(Format('Сканируем %s', [Dir]));



142
end;
144
end;


...
...
148
  NewFolder := GetNewFolder(Settings.FB2FolderTemplate, R);
150
  NewFolder := GetNewFolder(Settings.FB2FolderTemplate, R);



149
151



150
  CreateFolders(FRootPath, NewFolder);
152
  CreateFolders(FRootPath, NewFolder);



151
  CopyFile(Settings.InputFolder + R.FileName + R.FileExt,
153
  CopyFile(Settings.InputFolder + R.FileName + R.FileExt, FRootPath + NewFolder + R.FileName + R.FileExt);



152
    FRootPath + NewFolder + R.FileName + R.FileExt);



153
  R.Folder := NewFolder;
154
  R.Folder := NewFolder;



154
155



155
  NewFilename := GetNewFileName(Settings.FB2FileTemplate, R);
156
  NewFilename := GetNewFileName(Settings.FB2FileTemplate, R);



156
  if NewFilename <> '' then
157
  if NewFilename <> '' then



157
  begin
158
  begin



158
    RenameFile(FRootPath + NewFolder + R.FileName + R.FileExt,
159
    RenameFile(FRootPath + NewFolder + R.FileName + R.FileExt, FRootPath + NewFolder + NewFilename + R.FileExt);



159
      FRootPath + NewFolder + NewFilename + R.FileExt);



160
    R.FileName := NewFilename;
160
    R.FileName := NewFilename;



161
  end;
161
  end;



162
end;
162
end;



163
163



164
function TImportFB2ThreadBase.GetNewFileName(FileName: string; R: TBookRecord)
164
function TImportFB2ThreadBase.GetNewFileName(FileName: string; R: TBookRecord): string;



165
  : string;



166
var
165
var



167
  z, p1, p2: integer;
166
  z, p1, p2: Integer;



168
begin
167
begin



169
  { DONE -oNickR -cPerformance : необходимо создавать шаблонизатор только один раз при инициализации потока }
168
  { DONE -oNickR -cPerformance : необходимо создавать шаблонизатор только один раз при инициализации потока }



170
  { DONE -oNickR -cBug : нет реакции на невалидный шаблон }
169
  { DONE -oNickR -cBug : нет реакции на невалидный шаблон }


...
...
176
    Exit;
175
    Exit;



177
  end;
176
  end;



178
177



179
  FileName := CheckSymbols(trim(FileName));
178
  FileName := CheckSymbols(Trim(FileName));



180
  if FileName <> '' then
179
  if FileName <> '' then



181
    Result := FileName
180
    Result := FileName



182
  else
181
  else



183
    Result := '';
182
    Result := '';



184
end;
183
end;



185
184



186
function TImportFB2ThreadBase.GetNewFolder(Folder: string; R: TBookRecord)
185
function TImportFB2ThreadBase.GetNewFolder(Folder: string; R: TBookRecord): string;



187
  : string;



188
begin
186
begin



189
  { DONE -oNickR -cPerformance : необходимо создавать шаблонизатор только один раз при инициализации потока }
187
  { DONE -oNickR -cPerformance : необходимо создавать шаблонизатор только один раз при инициализации потока }



190
  { DONE -oNickR -cBug : нет реакции на невалидный шаблон }
188
  { DONE -oNickR -cBug : нет реакции на невалидный шаблон }


...
...
196
    Exit;
194
    Exit;



197
  end;
195
  end;



198
196



199
  Folder := CheckSymbols(trim(Folder));
197
  Folder := CheckSymbols(Trim(Folder));



200
  if Folder <> '' then
198
  if Folder <> '' then



201
    Result := IncludeTrailingPathDelimiter(Folder)
199
    Result := IncludeTrailingPathDelimiter(Folder)



202
  else
200
  else


...
...
215
  FFilesList.OnFile := AddFile2List;
213
  FFilesList.OnFile := AddFile2List;



216
  try
214
  try



217
    if not Settings.EnableSort then
215
    if not Settings.EnableSort then



218
      FFilesList.TargetPath := IncludeTrailingPathDelimiter
216
      FFilesList.TargetPath := IncludeTrailingPathDelimiter(DMUser.ActiveCollection.RootFolder)



219
        (DMUser.ActiveCollection.RootFolder)



220
    else
217
    else



221
      FFilesList.TargetPath := IncludeTrailingPathDelimiter
218
      FFilesList.TargetPath := IncludeTrailingPathDelimiter(Settings.InputFolder);



222
        (Settings.InputFolder);



223
219



224
    FFilesList.OnDirectory := ShowCurrentDir;
220
    FFilesList.OnDirectory := ShowCurrentDir;



225
    try
221
    try