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

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