Develop and Download Open Source Software

Browse CVS Repository

Diff of /gikonavigoeson/gikonavi/NewBoard.pas

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph | View Patch Patch

revision 1.3 by h677, Sun Oct 5 14:31:47 2003 UTC revision 1.3.2.2 by yoffy, Thu Sep 9 16:20:33 2004 UTC
# Line 6  uses Line 6  uses
6          Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,          Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7          Dialogs, IdAntiFreezeBase, IdAntiFreeze, IdBaseComponent, IdComponent,          Dialogs, IdAntiFreezeBase, IdAntiFreeze, IdBaseComponent, IdComponent,
8          IdTCPConnection, IdTCPClient, IdHTTP, IDException, StdCtrls, IniFiles,          IdTCPConnection, IdTCPClient, IdHTTP, IDException, StdCtrls, IniFiles,
9          GikoSystem, BoardGroup;          GikoSystem, BoardGroup, MojuUtils;
10    
11  type  type
12          TNewBoardItem = record          TNewBoardItem = record
# Line 18  type Line 18  type
18                  Label1: TLabel;                  Label1: TLabel;
19                  MessageMemo: TMemo;                  MessageMemo: TMemo;
20                  UpdateButton: TButton;                  UpdateButton: TButton;
21      CloseButton: TButton;          CloseButton: TButton;
22                  Indy: TIdHTTP;                  Indy: TIdHTTP;
23                  IdAntiFreeze: TIdAntiFreeze;                  IdAntiFreeze: TIdAntiFreeze;
24                  StopButton: TButton;                  StopButton: TButton;
25                  Label2: TLabel;                  Label2: TLabel;
26      BoardURLComboBox: TComboBox;          BoardURLComboBox: TComboBox;
27      Label13: TLabel;          Label13: TLabel;
28            EditIgnoreListsButton: TButton;
29                  procedure UpdateButtonClick(Sender: TObject);                  procedure UpdateButtonClick(Sender: TObject);
30                  procedure StopButtonClick(Sender: TObject);                  procedure StopButtonClick(Sender: TObject);
31                  procedure CloseButtonClick(Sender: TObject);                  procedure CloseButtonClick(Sender: TObject);
32                  procedure FormCreate(Sender: TObject);                  procedure FormCreate(Sender: TObject);
33            procedure EditIgnoreListsButtonClick(Sender: TObject);
34        procedure FormClose(Sender: TObject; var Action: TCloseAction);
35          private          private
36                  { Private 宣言 }                  { Private 宣言 }
37                    IgnoreLists : TStringList;
38                  FAbort: Boolean;                  FAbort: Boolean;
39                  function BoardDownload: TNewBoardItem;                  function BoardDownload: TNewBoardItem;
40                  procedure UpdateURL(s: string);                  procedure UpdateURL(s: string);
41                    procedure SetIgnoreCategory(b: boolean);
42                    procedure EditIgnoreList(Sender: TObject);
43                    procedure UpdateIgnoreList(Sender: TObject);
44          public          public
45                  { Public 宣言 }                  { Public 宣言 }
46          end;          end;
# Line 41  type Line 48  type
48  var  var
49          NewBoardDialog: TNewBoardDialog;          NewBoardDialog: TNewBoardDialog;
50    
51    
52  implementation  implementation
53    
54  uses Giko, IdHeaderList;  uses Giko, IdHeaderList;
# Line 170  end; Line 178  end;
178  procedure TNewBoardDialog.UpdateURL(s: string);  procedure TNewBoardDialog.UpdateURL(s: string);
179  var  var
180          i: Integer;          i: Integer;
181    //      j: Integer;
182          idx: Integer;          idx: Integer;
183          idx1: Integer;          idx1: Integer;
184          idx2: Integer;          idx2: Integer;
# Line 179  var Line 188  var
188          cate: string;          cate: string;
189          Board: TBoard;          Board: TBoard;
190          Change: Boolean;          Change: Boolean;
191            Ignore: Boolean;
192          ini: TMemIniFile;          ini: TMemIniFile;
193            oldURLs : TStringList;
194            newURLs : TStringList;
195  begin  begin
196          Change := False;          Change := False;
197          MessageMemo.Lines.Add('新板、板URL変更チェックを開始します');          MessageMemo.Lines.Add('新板、板URL変更チェックを開始します');
198          MessageMemo.Lines.Add('');          MessageMemo.Lines.Add('');
199          s := StringReplace(s, '<B>', '<b>', [rfReplaceAll, rfIgnoreCase]);          s := CustomStringReplace(s, '<B>', '<b>', true);
200          s := StringReplace(s, '<BR>', '<br>', [rfReplaceAll, rfIgnoreCase]);          s := CustomStringReplace(s, '<BR>', '<br>', true);
201          s := StringReplace(s, '</B>', '</b>', [rfReplaceAll, rfIgnoreCase]);          s := CustomStringReplace(s, '</B>', '</b>', true);
202          s := StringReplace(s, '<A HREF', '<a href', [rfReplaceAll, rfIgnoreCase]);          s := CustomStringReplace(s, '<A HREF', '<a href', true);
203          s := StringReplace(s, '</A', '</a', [rfReplaceAll, rfIgnoreCase]);          s := CustomStringReplace(s, '</A', '</a', true);
204          cate := '';          cate := '';
205          GikoSys.ForceDirectoriesEx(GikoSys.GetConfigDir);  
206          ini := TMemIniFile.Create(GikoSys.GetBoardFileName);          oldURLs := TStringList.Create;
207            newURLs := TStringList.Create;
208    
209          try          try
                 //  
                 //削除オプションが選択されている場合はクリア  
210    
211                  ini.Clear;                  GikoSys.ForceDirectoriesEx(GikoSys.GetConfigDir);
212                  while True do begin                  ini := TMemIniFile.Create(GikoSys.GetBoardFileName);
213                          idx1 := AnsiPos('<b>', s);                  try
214                          idx2 := AnsiPos('<a', s);                          //
215                          if (idx1 = 0) and (idx2 = 0) then Break;                          //削除オプションが選択されている場合はクリア
216    
217                          if idx1 < idx2 then begin                          ini.Clear;
218                                  //<br>  
219                                  idx := AnsiPos('</b>', s);                          while True do begin
220                                  if idx = 0 then begin                                  idx1 := AnsiPos('<b>', s);
221                                          s := Copy(s, idx1 + 4, Length(s));                                  idx2 := AnsiPos('<a', s);
222                                          continue;                                  if (idx1 = 0) and (idx2 = 0) then Break;
223                                  end;  
224                                  tmp := Copy(s, idx1, (idx - idx1) + 4);                                  if idx1 < idx2 then begin
225                                  tmp := StringReplace(tmp, '<b>', '', [rfReplaceAll]);                                          //<br>
226                                  tmp := StringReplace(tmp, '</b>', '', [rfReplaceAll]);                                          idx := AnsiPos('</b>', s);
227                                            if idx = 0 then begin
228                                  if (tmp = 'おすすめ') or                                                  s := Copy(s, idx1 + 4, Length(s));
229                                           (tmp = '特別企画') or                                                  continue;
230                                           (tmp = 'まちBBS') or                                          end;
231                                           (tmp = 'チャット') or                                          tmp := Copy(s, idx1, (idx - idx1) + 4);
232                                           (tmp = 'お絵かき') or                                          tmp := CustomStringReplace(tmp, '<b>', '');
233                                           (tmp = '運営') or                                          tmp := CustomStringReplace(tmp, '</b>', '');
234                                           (tmp = 'ツール類') or                                          Ignore := false;
235                                           (tmp = '他のサイト') then begin                                          for i := 0 to IgnoreLists.Count - 1 do begin
236                                          cate := '';                                                  if tmp = Trim(IgnoreLists[i]) then begin
237                                                            cate := '';
238                                                            s := Copy(s, idx + 5, Length(s));
239                                                            Ignore := True;
240                                                            break;
241                                                    end;
242                                            end;
243                                            if Ignore then
244                                                    Continue;
245                                            {
246                                            if (tmp = 'おすすめ') or
247                                                     (tmp = '特別企画') or
248                                                     (tmp = 'まちBBS') or
249                                                     (tmp = 'チャット') or
250                                                     (tmp = 'お絵かき') or
251                                                     (tmp = '運営案内') or
252                                                     (tmp = 'ツール類') or
253                                                     (tmp = '他のサイト') then begin
254                                                    cate := '';
255                                                    s := Copy(s, idx + 5, Length(s));
256                                                    Continue;
257                                            end;
258                                            }
259                                          s := Copy(s, idx + 5, Length(s));                                          s := Copy(s, idx + 5, Length(s));
260                                          Continue;                                          cate := tmp;
                                 end;  
                                 s := Copy(s, idx + 5, Length(s));  
                                 cate := tmp;  
                         end else begin  
                                 //<a href=  
                                 if cate = '' then begin  
                                         s := Copy(s, idx2 + 2, Length(s));  
261                                  end else begin                                  end else begin
262                                          idx := AnsiPos('</a>', s);                                          //<a href=
263                                          tmp := Copy(s, idx2, (idx - idx2) + 4);                                          if cate = '' then begin
264                                          tmp := StringReplace(tmp, '<a href=', '', [rfReplaceAll]);                                                  s := Copy(s, idx2 + 2, Length(s));
265                                          tmp := StringReplace(tmp, '</a>', '', [rfReplaceAll]);                                          end else begin
266                                          i := AnsiPos('>', tmp);                                                  idx := AnsiPos('</a>', s);
267                                          if i <> 0 then begin                                                  tmp := Copy(s, idx2, (idx - idx2) + 4);
268                                                  URL := Copy(tmp, 1, i - 1);                                                  tmp := CustomStringReplace(tmp, '<a href=', '');
269                                                  Title := Copy(tmp, i + 1, Length(tmp));                                                  tmp := CustomStringReplace(tmp, '</a>', '');
270                                                  Board := BBS2ch.FindBoardFromTitle(Title);                          tmp := CustomStringReplace(tmp, 'TARGET=_blank', '');
271                                                  if Board = nil then begin                                                  i := AnsiPos('>', tmp);
272                                                          MessageMemo.Lines.Add('新板追加「' + Title + '(' + URL + ')」');                                                  if i <> 0 then begin
273                                                          ini.WriteString(cate, Title, URL);                                                          URL := Copy(tmp, 1, i - 1);
274                                                          Change := True;                                                          Title := Copy(tmp, i + 1, Length(tmp));
275                                Board := BBSs[ 0 ].FindBoardFromTitle(Title);
276                                if Board = nil then begin
277                                    MessageMemo.Lines.Add('新板追加「' + Title + '(' + URL + ')」');
278                                    ini.WriteString(cate, Title, URL);
279                                    Change := True;
280                                end else begin
281                                    if Board.URL <> URL then begin
282                                            MessageMemo.Lines.Add('URL変更「' + Board.Title + '(' + URL +')」');
283                                        ini.WriteString(cate, Title, URL);
284                                        oldURLs.Add(Board.URL);
285                                        newURLs.Add(URL);
286                                        Change := True;
287                                    end else begin
288                                            ini.WriteString(cate, Title, URL);
289                                    end;
290                                end;
291                                                  end else begin                                                  end else begin
292                                                          if Board.URL <> URL then begin                                                          s := Copy(s, idx2 + 2, Length(s));
293                                                                  MessageMemo.Lines.Add('URL変更「' + Board.Title + '(' + URL +')」');                                                          Continue;
                                                                 ini.WriteString(cate, Title, URL);  
                                                                 Change := True;  
                                                         end else begin  
                                                                 ini.WriteString(cate, Title, URL);  
                                                         end;  
294                                                  end;                                                  end;
295                                          end else begin                                                  s := Copy(s, idx + 5, Length(s));
                                                 s := Copy(s, idx2 + 2, Length(s));  
                                                 Continue;  
296                                          end;                                          end;
                                         s := Copy(s, idx + 5, Length(s));  
297                                  end;                                  end;
298                          end;                          end;
299                    finally
300                            if Change then
301                                    ini.UpdateFile;
302                            ini.Free;
303                  end;                  end;
304          finally                  MessageMemo.Lines.Add('');
305                  if Change then              if Change then begin
306                          ini.UpdateFile;              GikoForm.FavoritesURLReplace(oldURLs, newURLs);
307                  ini.Free;              GikoForm.RoundListURLReplace(oldURLs, newURLs);
308    //            GikoForm.TabFileURLReplace(oldURLs, newURLs);
309                            MessageMemo.Lines.Add('新板、板URL変更チェックが完了しました');
310                            MessageMemo.Lines.Add('「閉じる」ボタンを押してください');
311                    end else
312                            MessageMemo.Lines.Add('新板、板URL変更は ありませんでした');
313        finally
314            oldURLs.Free;
315            newURLs.Free;
316          end;          end;
         MessageMemo.Lines.Add('');  
         if Change then begin  
                 MessageMemo.Lines.Add('新板、板URL変更チェックが完了しました');  
                 MessageMemo.Lines.Add('「閉じる」ボタンを押してください');  
         end else  
                 MessageMemo.Lines.Add('新板、板URL変更は ありませんでした');  
317  end;  end;
318    
319  procedure TNewBoardDialog.FormCreate(Sender: TObject);  procedure TNewBoardDialog.FormCreate(Sender: TObject);
320  begin  begin
321          StopButton.Enabled := False;          StopButton.Enabled := False;
322      BoardURLComboBox.Clear;          BoardURLComboBox.Clear;
323      BoardURLComboBox.Items.AddStrings(GikoSys.Setting.BoardURLs);          BoardURLComboBox.Items.AddStrings(GikoSys.Setting.BoardURLs);
324      try          try
325          BoardURLComboBox.ItemIndex := GikoSys.Setting.BoardURLSelected - 1;                  BoardURLComboBox.ItemIndex := GikoSys.Setting.BoardURLSelected - 1;
326      except          except
327          BoardURLComboBox.ItemIndex := 0;                  BoardURLComboBox.ItemIndex := 0;
328      end;          end;
329            SetIgnoreCategory(false);
330    end;
331    //板更新の除外カテゴリリストの登録
332    {['おすすめ', '特別企画', 'まちBBS', 'チャット', 'お絵かき', '運営案内', 'ツール類', '他のサイト']}
333    procedure TNewBoardDialog.SetIgnoreCategory(b: boolean);
334    begin
335            IgnoreLists := TStringList.Create;
336            if not( FileExists(GikoSys.Setting.GetIgnoreFileName) ) or ( b )then begin
337                    IgnoreLists.Add('おすすめ');
338                    IgnoreLists.Add('特別企画');
339                    IgnoreLists.Add('まちBBS');
340                    IgnoreLists.Add('チャット');
341                    IgnoreLists.Add('お絵かき');
342                    IgnoreLists.Add('運営案内');
343                    IgnoreLists.Add('ツール類');
344                    IgnoreLists.Add('他のサイト');
345            end else begin
346                    try
347                            IgnoreLists.LoadFromFile(GikoSys.Setting.GetIgnoreFileName);
348                    except
349                            IgnoreLists.Free;
350                            SetIgnoreCategory(true);
351                    end;
352            end;
353    end;
354    
355    procedure TNewBoardDialog.EditIgnoreListsButtonClick(Sender: TObject);
356    begin
357            EditIgnoreList(Sender);
358            EditIgnoreListsButton.OnClick := UpdateIgnoreList;
359    end;
360    procedure TNewBoardDialog.EditIgnoreList(Sender: TObject);
361    var
362            i: Integer;
363    begin
364            EditIgnoreListsButton.Caption := '除外カテゴリー更新';
365            Label2.Caption := '各1行にカテゴリ名を記入してください。(改行はCtrl+Enter)';
366            UpdateButton.Enabled := false;
367            //MessageMemo.ReadOnly := false;
368            MessageMemo.Clear;
369            for i := 0 to IgnoreLists.Count - 1 do
370                    MessageMemo.Lines.Add(IgnoreLists[i]);
371    end;
372    procedure TNewBoardDialog.UpdateIgnoreList(Sender: TObject);
373    var
374            i: Integer;
375    begin
376            Label2.Caption := '※現在、開いているタブやヒストリなどは板更新時にクリアされます';
377        UpdateButton.Enabled := true;
378            EditIgnoreListsButton.Caption := '除外カテゴリー編集';
379            IgnoreLists.Clear;
380            for i := 0 to MessageMemo.Lines.Count - 1 do
381                    IgnoreLists.Add(MessageMemo.Lines[i]);
382            IgnoreLists.SaveToFile(GikoSys.Setting.GetIgnoreFileName);
383            IgnoreLists.Free;
384            SetIgnoreCategory(false);
385            //MessageMemo.ReadOnly := true;
386            MessageMemo.Clear;
387            EditIgnoreListsButton.OnClick := EditIgnoreListsButtonClick;
388    end;
389    
390    procedure TNewBoardDialog.FormClose(Sender: TObject;
391      var Action: TCloseAction);
392    begin
393            IgnoreLists.Free;
394  end;  end;
395    
396  end.  end.

Legend:
Removed from v.1.3  
changed lines
  Added in v.1.3.2.2

Back to OSDN">Back to OSDN
ViewVC Help
Powered by ViewVC 1.1.26