Develop and Download Open Source Software

Browse CVS Repository

Annotation of /gikonavigoeson/gikonavi/NewBoard.pas

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


Revision 1.30 - (hide annotations) (download) (as text)
Sat Mar 29 02:25:23 2008 UTC (16 years ago) by h677
Branch: MAIN
CVS Tags: v1_59_0_771, v1_59_0_770, v1_59_0_773, v1_59_0_772, v1_59_0_775, v1_59_0_774, v1_59_0_777, v1_59_0_776, v1_59_0_778, v1_59_1_765, v1_60_0_788, v1_60_0_781, v1_60_0_782, v1_60_0_784, v1_60_0_786, v1_60_0_787, v1_59_0_767, v1_59_1_778, v1_59_0_768, v1_59_0_769, v1_58_0_752, v1_58_0_751, v1_58_0_756, v1_58_0_757, v1_58_0_754, v1_58_0_755, v1_58_0_759, v1_60_0_780, v1_60_0_779, v1_60_0_783, v1_59_2_785, v1_58_0_763, v1_58_0_762, v1_58_0_761, v1_58_0_760
Branch point for: Bb59, Bb58
Changes since 1.29: +52 -1 lines
File MIME type: text/x-pascal
板、カテゴリがなくなっただけだと更新がかからなかった不具合の修正

1 hi_ 1.1 unit NewBoard;
2    
3     interface
4    
5     uses
6     Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7     Dialogs, IdAntiFreezeBase, IdAntiFreeze, IdBaseComponent, IdComponent,
8     IdTCPConnection, IdTCPClient, IdHTTP, IDException, StdCtrls, IniFiles,
9 h677 1.21 GikoSystem, BoardGroup;
10 hi_ 1.1
11     type
12     TNewBoardItem = record
13     FResponseCode: Integer;
14     FContent: string;
15     end;
16    
17     TNewBoardDialog = class(TForm)
18     Label1: TLabel;
19     MessageMemo: TMemo;
20     UpdateButton: TButton;
21 h677 1.12 CloseButton: TButton;
22 hi_ 1.1 Indy: TIdHTTP;
23     IdAntiFreeze: TIdAntiFreeze;
24     StopButton: TButton;
25 h677 1.12 BoardURLComboBox: TComboBox;
26     Label13: TLabel;
27     EditIgnoreListsButton: TButton;
28 h677 1.21 Label2: TLabel;
29 hi_ 1.1 procedure UpdateButtonClick(Sender: TObject);
30     procedure StopButtonClick(Sender: TObject);
31     procedure CloseButtonClick(Sender: TObject);
32     procedure FormCreate(Sender: TObject);
33 h677 1.12 procedure EditIgnoreListsButtonClick(Sender: TObject);
34 h677 1.21 procedure FormClose(Sender: TObject; var Action: TCloseAction);
35 hi_ 1.1 private
36     { Private ?辿?転 }
37 h677 1.12 IgnoreLists : TStringList;
38 hi_ 1.1 FAbort: Boolean;
39 h677 1.23 function BoardDownload(const URL: String): TNewBoardItem;
40     function BoardLoardFromFile(const FilePath: String): String;
41     function UpdateURL(s: string): boolean;
42 h677 1.12 procedure SetIgnoreCategory(b: boolean);
43     procedure EditIgnoreList(Sender: TObject);
44     procedure UpdateIgnoreList(Sender: TObject);
45 h677 1.30 function CheckDeleteItem(ini: TMemIniFile): Boolean;
46 hi_ 1.1 public
47     { Public ?辿?転 }
48 h677 1.28 class procedure InitHTTPClient(client : TIdHTTP);
49 hi_ 1.1 end;
50    
51     var
52     NewBoardDialog: TNewBoardDialog;
53    
54 h677 1.12
55 hi_ 1.1 implementation
56    
57 h677 1.22 uses Giko, IdHeaderList, MojuUtils, GikoDataModule;
58 hi_ 1.1
59     {$R *.dfm}
60    
61     procedure TNewBoardDialog.UpdateButtonClick(Sender: TObject);
62     var
63     Item: TNewBoardItem;
64 h677 1.23 URL : String;
65     protocol, host, path, document, port, bookmark: String;
66 h677 1.27 TabURLs: TStringList;
67 hi_ 1.1 begin
68     try
69 h677 1.25 MessageMemo.Clear;
70 h677 1.21 GikoSys.Setting.BoardURLSelected := BoardURLComboBox.ItemIndex + 1;
71 hi_ 1.1 FAbort := False;
72     UpdateButton.Enabled := False;
73     StopButton.Enabled := True;
74     CloseButton.Enabled := False;
75 q9_ 1.18 EditIgnoreListsButton.Enabled := False;
76 h677 1.23 URL := BoardURLComboBox.Text;
77     GikoSys.ParseURI(URL, protocol, host, path, document, port, bookmark);
78     if (protocol = '') then begin
79     Item.FContent := BoardLoardFromFile(URL);
80     end else if (AnsiPos('http', protocol) > 0) then begin
81     Item := BoardDownload(URL);
82     end;
83 hi_ 1.1 StopButton.Enabled := False;
84     if FAbort then
85     Exit;
86     if Item.FContent <> '' then begin
87 h677 1.27 TabURLs := TStringList.Create;
88     try
89     GikoDM.GetTabURLs(TabURLs);
90     if (UpdateURL(Item.FContent)) then begin
91     GikoForm.ReloadBBS;
92     end;
93     GikoDM.OpenURLs(TabURLs);
94     finally
95     TabURLs.Free;
96     end;
97 hi_ 1.1 end else
98     MessageMemo.Lines.Add('?_?E?????[?h???存?s?直???直??[' + IntToStr(Item.FResponseCode) + ']');
99     finally
100     UpdateButton.Enabled := True;
101     StopButton.Enabled := False;
102     CloseButton.Enabled := True;
103 q9_ 1.18 EditIgnoreListsButton.Enabled := True;
104 hi_ 1.1 end;
105     end;
106    
107     procedure TNewBoardDialog.StopButtonClick(Sender: TObject);
108     begin
109     FAbort := True;
110     Indy.DisconnectSocket;
111     end;
112    
113     procedure TNewBoardDialog.CloseButtonClick(Sender: TObject);
114     begin
115     Close;
116     end;
117    
118 h677 1.23 function TNewBoardDialog.BoardDownload(const URL: String): TNewBoardItem;
119 hi_ 1.1 var
120     Stream: TMemoryStream;
121     s: string;
122     i: Integer;
123     begin
124 h677 1.28 InitHTTPClient( Indy );
125    
126 hi_ 1.1 Indy.Request.UserAgent := GikoSys.GetUserAgent;
127     Indy.Request.Referer := '';
128     Indy.Request.AcceptEncoding := 'gzip';
129    
130     Indy.Request.CacheControl := 'no-cache';
131     Indy.Request.CustomHeaders.Add('Pragma: no-cache');
132    
133     // s := '';
134     Stream := TMemoryStream.Create;
135     try
136     try
137     MessageMemo.Lines.Add('?????????????巽???転?直????');
138 h677 1.3 //MessageMemo.Lines.Add(GikoSys.Setting.BoardURL2ch);
139 h677 1.20 MessageMemo.Lines.Add(URL);
140 hi_ 1.1 MessageMemo.Lines.Add('?_?E?????[?h???J?n?直????');
141 h677 1.20 IdAntiFreeze.Active := True;
142     try
143     Indy.Get(URL, Stream);
144     finally
145     IdAntiFreeze.Active := False;
146     end;
147 hi_ 1.1 Result.FContent := GikoSys.GzipDecompress(Stream, Indy.Response.ContentEncoding);
148     MessageMemo.Lines.Add('?_?E?????[?h???貼?邸?直???直??');
149     except
150     on E: EIdConnectException do begin
151     MessageMemo.Lines.Add('');
152 yoffy 1.2 MessageMemo.Lines.Add('???????存?s?直???直?? ???端?但?v???L?V?AFW???坦???????????足?転????');
153     MessageMemo.Lines.Add('FW???端???????辿?l?????????m?F?直???足?転????');
154     MessageMemo.Lines.Add('NEC??PC????????PC GATE???鼎?????直?????辿???\?鼎???????長??');
155 hi_ 1.1 MessageMemo.Lines.Add('Message: ' + E.Message);
156     end;
157     on E: Exception do begin
158     if FAbort then
159     MessageMemo.Lines.Add('?_?E?????[?h?????f?直???直??')
160     else begin
161     MessageMemo.Lines.Add('?_?E?????[?h???存?s?直???直??');
162     MessageMemo.Lines.Add('ResponseCode: ' + IntToStr(Indy.ResponseCode));
163     MessageMemo.Lines.Add('Message: ' + E.Message);
164     MessageMemo.Lines.Add('------------------------');
165     for i := 0 to Indy.Response.RawHeaders.Count - 1 do begin
166     s := Indy.Response.RawHeaders.Names[i];
167     s := s + ': ' + Indy.Response.RawHeaders.Values[s];
168     MessageMemo.Lines.Add(s);
169     end;
170     MessageMemo.Lines.Add('------------------------');
171     end;
172     end;
173     end;
174     Result.FResponseCode := Indy.ResponseCode;
175     finally
176     Stream.Free;
177     end;
178     end;
179    
180 h677 1.23 function TNewBoardDialog.UpdateURL(s: string): boolean;
181 hi_ 1.1 var
182     i: Integer;
183     idx: Integer;
184     idx1: Integer;
185     idx2: Integer;
186     tmp: string;
187     URL: string;
188     Title: string;
189     cate: string;
190     Board: TBoard;
191     Change: Boolean;
192 h677 1.12 Ignore: Boolean;
193 hi_ 1.1 ini: TMemIniFile;
194 h677 1.12 oldURLs : TStringList;
195     newURLs : TStringList;
196 hi_ 1.1 begin
197     Change := False;
198     MessageMemo.Lines.Add('?V???A??URL???X?`?F?b?N???J?n?直????');
199     MessageMemo.Lines.Add('');
200 h677 1.6 s := CustomStringReplace(s, '<B>', '<b>', true);
201     s := CustomStringReplace(s, '<BR>', '<br>', true);
202     s := CustomStringReplace(s, '</B>', '</b>', true);
203     s := CustomStringReplace(s, '<A HREF', '<a href', true);
204     s := CustomStringReplace(s, '</A', '</a', true);
205 hi_ 1.1 cate := '';
206 h677 1.6
207 h677 1.12 oldURLs := TStringList.Create;
208     newURLs := TStringList.Create;
209 h677 1.6
210 hi_ 1.1 try
211    
212 h677 1.6 GikoSys.ForceDirectoriesEx(GikoSys.GetConfigDir);
213     ini := TMemIniFile.Create(GikoSys.GetBoardFileName);
214     try
215     //
216     //?鱈???I?v?V???????I???????????辿???????N???A
217    
218     ini.Clear;
219    
220     while True do begin
221     idx1 := AnsiPos('<b>', s);
222     idx2 := AnsiPos('<a', s);
223     if (idx1 = 0) and (idx2 = 0) then Break;
224    
225     if idx1 < idx2 then begin
226     //<br>
227     idx := AnsiPos('</b>', s);
228     if idx = 0 then begin
229     s := Copy(s, idx1 + 4, Length(s));
230     continue;
231     end;
232     tmp := Copy(s, idx1, (idx - idx1) + 4);
233     tmp := CustomStringReplace(tmp, '<b>', '');
234     tmp := CustomStringReplace(tmp, '</b>', '');
235 h677 1.12 Ignore := false;
236     for i := 0 to IgnoreLists.Count - 1 do begin
237     if tmp = Trim(IgnoreLists[i]) then begin
238     cate := '';
239     s := Copy(s, idx + 5, Length(s));
240     Ignore := True;
241     break;
242     end;
243     end;
244     if Ignore then
245     Continue;
246     {
247 h677 1.6 if (tmp = '?即??????') or
248     (tmp = '?????辿??') or
249 h677 1.8 (tmp = '???甜?a?a?r') or
250 h677 1.6 (tmp = '?`???b?g') or
251     (tmp = '?即?G???鼎') or
252 h677 1.9 (tmp = '?^?c????') or
253 h677 1.6 (tmp = '?c?[???鄭') or
254     (tmp = '?添???T?C?g') then begin
255     cate := '';
256     s := Copy(s, idx + 5, Length(s));
257     Continue;
258     end;
259 h677 1.12 }
260 hi_ 1.1 s := Copy(s, idx + 5, Length(s));
261 h677 1.6 cate := tmp;
262 hi_ 1.1 end else begin
263 h677 1.6 //<a href=
264     if cate = '' then begin
265     s := Copy(s, idx2 + 2, Length(s));
266     end else begin
267     idx := AnsiPos('</a>', s);
268     tmp := Copy(s, idx2, (idx - idx2) + 4);
269     tmp := CustomStringReplace(tmp, '<a href=', '');
270     tmp := CustomStringReplace(tmp, '</a>', '');
271 h677 1.7 tmp := CustomStringReplace(tmp, 'TARGET=_blank', '');
272 h677 1.6 i := AnsiPos('>', tmp);
273     if i <> 0 then begin
274 h677 1.29 URL := Trim(Copy(tmp, 1, i - 1));
275 h677 1.6 Title := Copy(tmp, i + 1, Length(tmp));
276 h677 1.29 // BBSs???坦???担
277     if Length(BBSs) = 0 then begin
278     Board := nil;
279     end else begin
280     Board := BBSs[ 0 ].FindBoardFromTitle(Title);
281     end;
282 h677 1.8 if Board = nil then begin
283     MessageMemo.Lines.Add('?V???????u' + Title + '(' + URL + ')?v');
284     ini.WriteString(cate, Title, URL);
285     Change := True;
286     end else begin
287     if Board.URL <> URL then begin
288     MessageMemo.Lines.Add('URL???X?u' + Board.Title + '(' + URL +')?v');
289     ini.WriteString(cate, Title, URL);
290 h677 1.6 oldURLs.Add(Board.URL);
291 h677 1.8 newURLs.Add(URL);
292     Change := True;
293     end else begin
294     ini.WriteString(cate, Title, URL);
295     end;
296     end;
297 h677 1.6 end else begin
298     s := Copy(s, idx2 + 2, Length(s));
299     Continue;
300 hi_ 1.1 end;
301 h677 1.6 s := Copy(s, idx + 5, Length(s));
302 hi_ 1.1 end;
303     end;
304     end;
305 h677 1.30 // ?J?e?S??/?????存?????転?纏?転??Change?t???O?????????????鼎?????担
306     if not Change then begin
307     Change := CheckDeleteItem(ini);
308     end;
309 h677 1.6 finally
310     if Change then
311     ini.UpdateFile;
312     ini.Free;
313 hi_ 1.1 end;
314 h677 1.6 MessageMemo.Lines.Add('');
315     if Change then begin
316     GikoForm.FavoritesURLReplace(oldURLs, newURLs);
317 h677 1.11 GikoForm.RoundListURLReplace(oldURLs, newURLs);
318 genyakun 1.15 GikoForm.TabFileURLReplace(oldURLs, newURLs);
319 h677 1.6 MessageMemo.Lines.Add('?V???A??URL???X?`?F?b?N???貼?邸?直???直??');
320     MessageMemo.Lines.Add('?u?????辿?v?{?^???????直???足?転????');
321     end else
322     MessageMemo.Lines.Add('?V???A??URL???X?? ???????邸???長?直??');
323     finally
324     oldURLs.Free;
325     newURLs.Free;
326 h677 1.12 end;
327 h677 1.23 Result := Change;
328 hi_ 1.1 end;
329 h677 1.30 //! ?鱈???J?e?S??/???`?F?b?N
330     function TNewBoardDialog.CheckDeleteItem(ini: TMemIniFile): Boolean;
331     var
332     URL: string;
333     Title: string;
334     orgini: TMemIniFile;
335     orgStrings, newStrings: TStringList;
336     i: Integer;
337     begin
338     orgini := TMemIniFile.Create(GikoSys.GetBoardFileName);
339     orgStrings := TStringList.Create;
340     newStrings := TStringList.Create;
341     try
342     ini.ReadSections(newStrings);
343     orgini.ReadSections(orgStrings);
344     if (newStrings.Count <> orgStrings.Count) then begin
345     //?J?e?S?????????A?????????????辿???長?`?F?b?N?直???足????????
346     //?J?e?S?????鱈???`?F?b?N
347     for i := 0 to orgStrings.Count - 1 do begin
348     if (newStrings.IndexOf(orgStrings[i]) = -1) then begin
349     MessageMemo.Lines.Add('?J?e?S???鱈???u' + orgStrings[i] + '?v');
350     end;
351     end;
352     Result := True;
353     end else begin
354     // ???????`?F?b?N
355     ini.GetStrings(newStrings);
356     orgini.GetStrings(orgStrings);
357     if (newStrings.Count <> orgStrings.Count) then begin
358     // ?????鱈???`?F?b?N
359     for i := 0 to orgStrings.Count - 1 do begin
360     if (newStrings.IndexOf(orgStrings[i]) = -1) then begin
361     Title := Copy(orgStrings[i], 1 , AnsiPos('=',orgStrings[i]) - 1);
362     URL := Copy(orgStrings[i],
363     AnsiPos('=',orgStrings[i]) + 1, Length(orgStrings[i]));
364     MessageMemo.Lines.Add('???鱈???u' + Title + '(' + URL +')?v');
365     end;
366     end;
367     Result := True;
368     end;
369     end;
370     finally
371     orgStrings.Free;
372     newStrings.Free;
373     orgini.Free;
374     end;
375     end;
376 hi_ 1.1 procedure TNewBoardDialog.FormCreate(Sender: TObject);
377     begin
378     StopButton.Enabled := False;
379 h677 1.12 BoardURLComboBox.Clear;
380     BoardURLComboBox.Items.AddStrings(GikoSys.Setting.BoardURLs);
381     try
382     BoardURLComboBox.ItemIndex := GikoSys.Setting.BoardURLSelected - 1;
383     except
384     BoardURLComboBox.ItemIndex := 0;
385     end;
386     SetIgnoreCategory(false);
387     end;
388     //???X?V?????O?J?e?S?????X?g???o?^
389     {['?即??????', '?????辿??', '???甜?a?a?r', '?`???b?g', '?即?G???鼎', '?^?c????', '?c?[???鄭', '?添???T?C?g']}
390     procedure TNewBoardDialog.SetIgnoreCategory(b: boolean);
391     begin
392     IgnoreLists := TStringList.Create;
393     if not( FileExists(GikoSys.Setting.GetIgnoreFileName) ) or ( b )then begin
394     IgnoreLists.Add('?即??????');
395     IgnoreLists.Add('?????辿??');
396     IgnoreLists.Add('???甜?a?a?r');
397     IgnoreLists.Add('?`???b?g');
398     IgnoreLists.Add('?即?G???鼎');
399     IgnoreLists.Add('?^?c????');
400     IgnoreLists.Add('?c?[???鄭');
401     IgnoreLists.Add('?添???T?C?g');
402     end else begin
403     try
404     IgnoreLists.LoadFromFile(GikoSys.Setting.GetIgnoreFileName);
405     except
406     IgnoreLists.Free;
407     SetIgnoreCategory(true);
408     end;
409     end;
410     end;
411    
412     procedure TNewBoardDialog.EditIgnoreListsButtonClick(Sender: TObject);
413     begin
414     EditIgnoreList(Sender);
415     EditIgnoreListsButton.OnClick := UpdateIgnoreList;
416     end;
417     procedure TNewBoardDialog.EditIgnoreList(Sender: TObject);
418     var
419     i: Integer;
420     begin
421     EditIgnoreListsButton.Caption := '???O?J?e?S???[?X?V';
422     Label2.Caption := '?e?P?s???J?e?S???添???L?端?直???足?転?????B?i?端?s??Ctrl+Enter?j';
423     UpdateButton.Enabled := false;
424     //MessageMemo.ReadOnly := false;
425     MessageMemo.Clear;
426     for i := 0 to IgnoreLists.Count - 1 do
427     MessageMemo.Lines.Add(IgnoreLists[i]);
428     end;
429     procedure TNewBoardDialog.UpdateIgnoreList(Sender: TObject);
430     var
431     i: Integer;
432     begin
433 h677 1.19 Label2.Caption := '';
434 h677 1.12 UpdateButton.Enabled := true;
435     EditIgnoreListsButton.Caption := '???O?J?e?S???[???W';
436     IgnoreLists.Clear;
437     for i := 0 to MessageMemo.Lines.Count - 1 do
438     IgnoreLists.Add(MessageMemo.Lines[i]);
439     IgnoreLists.SaveToFile(GikoSys.Setting.GetIgnoreFileName);
440     IgnoreLists.Free;
441     SetIgnoreCategory(false);
442     //MessageMemo.ReadOnly := true;
443     MessageMemo.Clear;
444     EditIgnoreListsButton.OnClick := EditIgnoreListsButtonClick;
445     end;
446    
447     procedure TNewBoardDialog.FormClose(Sender: TObject;
448     var Action: TCloseAction);
449     begin
450     IgnoreLists.Free;
451 hi_ 1.1 end;
452 h677 1.23 //! ???[?J???t?@?C???????[?h???辿
453     function TNewBoardDialog.BoardLoardFromFile(const FilePath: String): String;
454     var
455     html : TStringList;
456     begin
457     Result := '';
458     // ?t?@?C?????????直?????辿???`?F?b?N
459     if (FileExists(FilePath)) then begin
460     html := TStringList.Create();
461     try
462     html.LoadFromFile(FilePath);
463     Result := html.Text;
464     finally
465     html.Free;
466     end;
467     end;
468     end;
469 h677 1.28
470     class procedure TNewBoardDialog.InitHTTPClient(client : TIdHTTP);
471     begin
472     client.Request.Clear;
473     client.Request.CustomHeaders.Clear;
474     client.RecvBufferSize := Gikosys.Setting.RecvBufferSize;
475     client.ProxyParams.BasicAuthentication := False;
476     if GikoSys.Setting.ReadProxy then begin
477     if GikoSys.Setting.ProxyProtocol then
478     client.ProtocolVersion := pv1_1
479     else
480     client.ProtocolVersion := pv1_0;
481     client.ProxyParams.ProxyServer := GikoSys.Setting.ReadProxyAddress;
482     client.ProxyParams.ProxyPort := GikoSys.Setting.ReadProxyPort;
483     client.ProxyParams.ProxyUsername := GikoSys.Setting.ReadProxyUserID;
484     client.ProxyParams.ProxyPassword := GikoSys.Setting.ReadProxyPassword;
485     if GikoSys.Setting.ReadProxyUserID <> '' then
486     client.ProxyParams.BasicAuthentication := True;
487     end else begin
488     if GikoSys.Setting.Protocol then
489     client.ProtocolVersion := pv1_1
490     else
491     client.ProtocolVersion := pv1_0;
492     client.ProxyParams.ProxyServer := '';
493     client.ProxyParams.ProxyPort := 80;
494     client.ProxyParams.ProxyUsername := '';
495     client.ProxyParams.ProxyPassword := '';
496     end;
497     end;
498 hi_ 1.1 end.

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