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.10 - (hide annotations) (download) (as text)
Mon Mar 15 12:15:26 2004 UTC (20 years, 1 month ago) by h677
Branch: MAIN
Changes since 1.9: +0 -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.6 GikoSystem, BoardGroup, MojuUtils;
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     CloseButton: TButton;
22     Indy: TIdHTTP;
23     IdAntiFreeze: TIdAntiFreeze;
24     StopButton: TButton;
25     Label2: TLabel;
26 h677 1.3 BoardURLComboBox: TComboBox;
27     Label13: TLabel;
28 hi_ 1.1 procedure UpdateButtonClick(Sender: TObject);
29     procedure StopButtonClick(Sender: TObject);
30     procedure CloseButtonClick(Sender: TObject);
31     procedure FormCreate(Sender: TObject);
32     private
33     { Private ?辿?転 }
34     FAbort: Boolean;
35     function BoardDownload: TNewBoardItem;
36     procedure UpdateURL(s: string);
37     public
38     { Public ?辿?転 }
39     end;
40    
41     var
42     NewBoardDialog: TNewBoardDialog;
43    
44     implementation
45    
46     uses Giko, IdHeaderList;
47    
48     {$R *.dfm}
49    
50     procedure TNewBoardDialog.UpdateButtonClick(Sender: TObject);
51     var
52     Item: TNewBoardItem;
53     begin
54     try
55 h677 1.3 GikoSys.Setting.BoardURLSelected := BoardURLComboBox.ItemIndex + 1;
56 hi_ 1.1 FAbort := False;
57     UpdateButton.Enabled := False;
58     StopButton.Enabled := True;
59     CloseButton.Enabled := False;
60     Item := BoardDownload;
61     StopButton.Enabled := False;
62     if FAbort then
63     Exit;
64     if Item.FContent <> '' then begin
65     UpdateURL(Item.FContent);
66     GikoForm.ReloadBBS;
67     end else
68     MessageMemo.Lines.Add('?_?E?????[?h???存?s?直???直??[' + IntToStr(Item.FResponseCode) + ']');
69     finally
70     UpdateButton.Enabled := True;
71     StopButton.Enabled := False;
72     CloseButton.Enabled := True;
73     end;
74     end;
75    
76     procedure TNewBoardDialog.StopButtonClick(Sender: TObject);
77     begin
78     FAbort := True;
79     Indy.DisconnectSocket;
80     end;
81    
82     procedure TNewBoardDialog.CloseButtonClick(Sender: TObject);
83     begin
84     Close;
85     end;
86    
87     function TNewBoardDialog.BoardDownload: TNewBoardItem;
88     var
89     URL: string;
90     Stream: TMemoryStream;
91     s: string;
92     i: Integer;
93     begin
94     MessageMemo.Clear;
95     Indy.Request.Clear;
96     Indy.RecvBufferSize := Gikosys.Setting.RecvBufferSize;
97     Indy.ProxyParams.BasicAuthentication := False;
98     if GikoSys.Setting.ReadProxy then begin
99     if GikoSys.Setting.ProxyProtocol then
100     Indy.ProtocolVersion := pv1_1
101     else
102     Indy.ProtocolVersion := pv1_0;
103     Indy.ProxyParams.ProxyServer := GikoSys.Setting.ReadProxyAddress;
104     Indy.ProxyParams.ProxyPort := GikoSys.Setting.ReadProxyPort;
105     Indy.ProxyParams.ProxyUsername := GikoSys.Setting.ReadProxyUserID;
106     Indy.ProxyParams.ProxyPassword := GikoSys.Setting.ReadProxyPassword;
107     if GikoSys.Setting.ReadProxyUserID <> '' then
108     Indy.ProxyParams.BasicAuthentication := True;
109     end else begin
110     if GikoSys.Setting.Protocol then
111     Indy.ProtocolVersion := pv1_1
112     else
113     Indy.ProtocolVersion := pv1_0;
114     Indy.ProxyParams.ProxyServer := '';
115     Indy.ProxyParams.ProxyPort := 80;
116     Indy.ProxyParams.ProxyUsername := '';
117     Indy.ProxyParams.ProxyPassword := '';
118     end;
119 h677 1.3 //URL := GikoSys.Setting.BoardURL2ch;
120     URL := BoardURLComboBox.Text;
121 hi_ 1.1 Indy.Request.UserAgent := GikoSys.GetUserAgent;
122     Indy.Request.Referer := '';
123     Indy.Request.AcceptEncoding := 'gzip';
124    
125     Indy.Request.CacheControl := 'no-cache';
126     Indy.Request.CustomHeaders.Add('Pragma: no-cache');
127    
128     // s := '';
129     Stream := TMemoryStream.Create;
130     try
131     try
132     MessageMemo.Lines.Add('?????????????巽???転?直????');
133 h677 1.3 //MessageMemo.Lines.Add(GikoSys.Setting.BoardURL2ch);
134     MessageMemo.Lines.Add(URL);
135 hi_ 1.1 MessageMemo.Lines.Add('?_?E?????[?h???J?n?直????');
136     Indy.Get(URL, Stream);
137     Result.FContent := GikoSys.GzipDecompress(Stream, Indy.Response.ContentEncoding);
138     MessageMemo.Lines.Add('?_?E?????[?h???貼?邸?直???直??');
139     except
140     on E: EIdConnectException do begin
141     MessageMemo.Lines.Add('');
142 yoffy 1.2 MessageMemo.Lines.Add('???????存?s?直???直?? ???端?但?v???L?V?AFW???坦???????????足?転????');
143     MessageMemo.Lines.Add('FW???端???????辿?l?????????m?F?直???足?転????');
144     MessageMemo.Lines.Add('NEC??PC????????PC GATE???鼎?????直?????辿???\?鼎???????長??');
145 hi_ 1.1 MessageMemo.Lines.Add('Message: ' + E.Message);
146     end;
147     on E: Exception do begin
148     if FAbort then
149     MessageMemo.Lines.Add('?_?E?????[?h?????f?直???直??')
150     else begin
151     MessageMemo.Lines.Add('?_?E?????[?h???存?s?直???直??');
152     MessageMemo.Lines.Add('ResponseCode: ' + IntToStr(Indy.ResponseCode));
153     MessageMemo.Lines.Add('Message: ' + E.Message);
154     MessageMemo.Lines.Add('------------------------');
155     for i := 0 to Indy.Response.RawHeaders.Count - 1 do begin
156     s := Indy.Response.RawHeaders.Names[i];
157     s := s + ': ' + Indy.Response.RawHeaders.Values[s];
158     MessageMemo.Lines.Add(s);
159     end;
160     MessageMemo.Lines.Add('------------------------');
161     end;
162     end;
163     end;
164     Result.FResponseCode := Indy.ResponseCode;
165     finally
166     Stream.Free;
167     end;
168     end;
169    
170     procedure TNewBoardDialog.UpdateURL(s: string);
171     var
172     i: Integer;
173     idx: Integer;
174     idx1: Integer;
175     idx2: Integer;
176     tmp: string;
177     URL: string;
178     Title: string;
179     cate: string;
180     Board: TBoard;
181     Change: Boolean;
182     ini: TMemIniFile;
183 h677 1.6 oldURLs : TStringList;
184     newURLs : TStringList;
185 hi_ 1.1 begin
186     Change := False;
187     MessageMemo.Lines.Add('?V???A??URL???X?`?F?b?N???J?n?直????');
188     MessageMemo.Lines.Add('');
189 h677 1.6 s := CustomStringReplace(s, '<B>', '<b>', true);
190     s := CustomStringReplace(s, '<BR>', '<br>', true);
191     s := CustomStringReplace(s, '</B>', '</b>', true);
192     s := CustomStringReplace(s, '<A HREF', '<a href', true);
193     s := CustomStringReplace(s, '</A', '</a', true);
194 hi_ 1.1 cate := '';
195 h677 1.6
196     oldURLs := TStringList.Create;
197     newURLs := TStringList.Create;
198    
199 hi_ 1.1 try
200    
201 h677 1.6 GikoSys.ForceDirectoriesEx(GikoSys.GetConfigDir);
202     ini := TMemIniFile.Create(GikoSys.GetBoardFileName);
203     try
204     //
205     //?鱈???I?v?V???????I???????????辿???????N???A
206    
207     ini.Clear;
208    
209     while True do begin
210     idx1 := AnsiPos('<b>', s);
211     idx2 := AnsiPos('<a', s);
212     if (idx1 = 0) and (idx2 = 0) then Break;
213    
214     if idx1 < idx2 then begin
215     //<br>
216     idx := AnsiPos('</b>', s);
217     if idx = 0 then begin
218     s := Copy(s, idx1 + 4, Length(s));
219     continue;
220     end;
221     tmp := Copy(s, idx1, (idx - idx1) + 4);
222     tmp := CustomStringReplace(tmp, '<b>', '');
223     tmp := CustomStringReplace(tmp, '</b>', '');
224    
225     if (tmp = '?即??????') or
226     (tmp = '?????辿??') or
227 h677 1.8 (tmp = '???甜?a?a?r') or
228 h677 1.6 (tmp = '?`???b?g') or
229     (tmp = '?即?G???鼎') or
230 h677 1.9 (tmp = '?^?c????') or
231 h677 1.6 (tmp = '?c?[???鄭') or
232     (tmp = '?添???T?C?g') then begin
233     cate := '';
234     s := Copy(s, idx + 5, Length(s));
235     Continue;
236     end;
237 hi_ 1.1 s := Copy(s, idx + 5, Length(s));
238 h677 1.6 cate := tmp;
239 hi_ 1.1 end else begin
240 h677 1.6 //<a href=
241     if cate = '' then begin
242     s := Copy(s, idx2 + 2, Length(s));
243     end else begin
244     idx := AnsiPos('</a>', s);
245     tmp := Copy(s, idx2, (idx - idx2) + 4);
246     tmp := CustomStringReplace(tmp, '<a href=', '');
247     tmp := CustomStringReplace(tmp, '</a>', '');
248 h677 1.7 tmp := CustomStringReplace(tmp, 'TARGET=_blank', '');
249 h677 1.6 i := AnsiPos('>', tmp);
250     if i <> 0 then begin
251     URL := Copy(tmp, 1, i - 1);
252     Title := Copy(tmp, i + 1, Length(tmp));
253 h677 1.8 Board := BBSs[ 0 ].FindBoardFromTitle(Title);
254     if Board = nil then begin
255     MessageMemo.Lines.Add('?V???????u' + Title + '(' + URL + ')?v');
256     ini.WriteString(cate, Title, URL);
257     Change := True;
258     end else begin
259     if Board.URL <> URL then begin
260     MessageMemo.Lines.Add('URL???X?u' + Board.Title + '(' + URL +')?v');
261     ini.WriteString(cate, Title, URL);
262 h677 1.6 oldURLs.Add(Board.URL);
263 h677 1.8 newURLs.Add(URL);
264     Change := True;
265     end else begin
266     ini.WriteString(cate, Title, URL);
267     end;
268     end;
269 h677 1.6 end else begin
270     s := Copy(s, idx2 + 2, Length(s));
271     Continue;
272 hi_ 1.1 end;
273 h677 1.6 s := Copy(s, idx + 5, Length(s));
274 hi_ 1.1 end;
275     end;
276     end;
277 h677 1.6 finally
278     if Change then
279     ini.UpdateFile;
280     ini.Free;
281 hi_ 1.1 end;
282 h677 1.6 MessageMemo.Lines.Add('');
283     if Change then begin
284     GikoForm.FavoritesURLReplace(oldURLs, newURLs);
285     MessageMemo.Lines.Add('?V???A??URL???X?`?F?b?N???貼?邸?直???直??');
286     MessageMemo.Lines.Add('?u?????辿?v?{?^???????直???足?転????');
287     end else
288     MessageMemo.Lines.Add('?V???A??URL???X?? ???????邸???長?直??');
289     finally
290     oldURLs.Free;
291     newURLs.Free;
292     end;
293 hi_ 1.1 end;
294    
295     procedure TNewBoardDialog.FormCreate(Sender: TObject);
296     begin
297     StopButton.Enabled := False;
298 h677 1.3 BoardURLComboBox.Clear;
299     BoardURLComboBox.Items.AddStrings(GikoSys.Setting.BoardURLs);
300     try
301     BoardURLComboBox.ItemIndex := GikoSys.Setting.BoardURLSelected - 1;
302     except
303     BoardURLComboBox.ItemIndex := 0;
304     end;
305 hi_ 1.1 end;
306    
307     end.

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