Develop and Download Open Source Software

Browse CVS Repository

Contents of /gikonavigoeson/gikonavi/NewBoard.pas

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


Revision 1.27 - (show annotations) (download) (as text)
Thu Jul 27 16:39:56 2006 UTC (17 years, 8 months ago) by h677
Branch: MAIN
CVS Tags: v1_53_0_671, v1_54_0_677, v1_54_0_676, v1_54_0_678, v1_54_0_684, v1_54_0_685, v1_53_0_669, v1_53_0_672, v1_53_0_670, v1_54_0_686, v1_54_0_680, v1_54_0_681, v1_54_0_682, v1_54_0_683, v1_54_0_679, v1_54_0_675, root-of-Bb53, v1_54_0_674, v1_53_1_673
Branch point for: Bb53
Changes since 1.26: +11 -6 lines
File MIME type: text/x-pascal
板更新時のタブの復元に,タブの保存の機構をそのまま使用しないように修正。

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

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