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.1 - (hide annotations) (download) (as text)
Sat Aug 9 13:51:08 2003 UTC (20 years, 8 months ago) by hi_
Branch: MAIN
Branch point for: hi
File MIME type: text/x-pascal
Initial revision

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     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     Label2: TLabel;
26     procedure UpdateButtonClick(Sender: TObject);
27     procedure StopButtonClick(Sender: TObject);
28     procedure CloseButtonClick(Sender: TObject);
29     procedure FormCreate(Sender: TObject);
30     private
31     { Private éŒž }
32     FAbort: Boolean;
33     function BoardDownload: TNewBoardItem;
34     procedure UpdateURL(s: string);
35     public
36     { Public éŒž }
37     end;
38    
39     var
40     NewBoardDialog: TNewBoardDialog;
41    
42     implementation
43    
44     uses Giko, IdHeaderList;
45    
46     {$R *.dfm}
47    
48     procedure TNewBoardDialog.UpdateButtonClick(Sender: TObject);
49     var
50     Item: TNewBoardItem;
51     begin
52     try
53     FAbort := False;
54     UpdateButton.Enabled := False;
55     StopButton.Enabled := True;
56     CloseButton.Enabled := False;
57     Item := BoardDownload;
58     StopButton.Enabled := False;
59     if FAbort then
60     Exit;
61     if Item.FContent <> '' then begin
62     UpdateURL(Item.FContent);
63     GikoForm.ReloadBBS;
64     end else
65     MessageMemo.Lines.Add('ƒ_ƒEƒ“ƒ[ƒh‚ŞŽ¸”s‚ľ‚Ü‚ľ‚˝[' + IntToStr(Item.FResponseCode) + ']');
66     finally
67     UpdateButton.Enabled := True;
68     StopButton.Enabled := False;
69     CloseButton.Enabled := True;
70     end;
71     end;
72    
73     procedure TNewBoardDialog.StopButtonClick(Sender: TObject);
74     begin
75     FAbort := True;
76     Indy.DisconnectSocket;
77     end;
78    
79     procedure TNewBoardDialog.CloseButtonClick(Sender: TObject);
80     begin
81     Close;
82     end;
83    
84     function TNewBoardDialog.BoardDownload: TNewBoardItem;
85     var
86     URL: string;
87     Stream: TMemoryStream;
88     s: string;
89     i: Integer;
90     begin
91     MessageMemo.Clear;
92     Indy.Request.Clear;
93     Indy.RecvBufferSize := Gikosys.Setting.RecvBufferSize;
94     Indy.ProxyParams.BasicAuthentication := False;
95     if GikoSys.Setting.ReadProxy then begin
96     if GikoSys.Setting.ProxyProtocol then
97     Indy.ProtocolVersion := pv1_1
98     else
99     Indy.ProtocolVersion := pv1_0;
100     Indy.ProxyParams.ProxyServer := GikoSys.Setting.ReadProxyAddress;
101     Indy.ProxyParams.ProxyPort := GikoSys.Setting.ReadProxyPort;
102     Indy.ProxyParams.ProxyUsername := GikoSys.Setting.ReadProxyUserID;
103     Indy.ProxyParams.ProxyPassword := GikoSys.Setting.ReadProxyPassword;
104     if GikoSys.Setting.ReadProxyUserID <> '' then
105     Indy.ProxyParams.BasicAuthentication := True;
106     end else begin
107     if GikoSys.Setting.Protocol then
108     Indy.ProtocolVersion := pv1_1
109     else
110     Indy.ProtocolVersion := pv1_0;
111     Indy.ProxyParams.ProxyServer := '';
112     Indy.ProxyParams.ProxyPort := 80;
113     Indy.ProxyParams.ProxyUsername := '';
114     Indy.ProxyParams.ProxyPassword := '';
115     end;
116     URL := GikoSys.Setting.BoardURL2ch;
117     Indy.Request.UserAgent := GikoSys.GetUserAgent;
118     Indy.Request.Referer := '';
119     Indy.Request.AcceptEncoding := 'gzip';
120    
121     Indy.Request.CacheControl := 'no-cache';
122     Indy.Request.CustomHeaders.Add('Pragma: no-cache');
123    
124     // s := '';
125     Stream := TMemoryStream.Create;
126     try
127     try
128     MessageMemo.Lines.Add('ˆČ‰ş‚̏ꏩ‚Š‚çŽć“ž‚ľ‚Ü‚ˇ');
129     MessageMemo.Lines.Add(GikoSys.Setting.BoardURL2ch);
130     MessageMemo.Lines.Add('ƒ_ƒEƒ“ƒ[ƒh‚đŠJŽn‚ľ‚Ü‚ˇ');
131     Indy.Get(URL, Stream);
132     Result.FContent := GikoSys.GzipDecompress(Stream, Indy.Response.ContentEncoding);
133     MessageMemo.Lines.Add('ƒ_ƒEƒ“ƒ[ƒh‚ŞŠŽ—š‚ľ‚Ü‚ľ‚˝');
134     except
135     on E: EIdConnectException do begin
136     MessageMemo.Lines.Add('');
137     MessageMemo.Lines.Add('Ú‘ą‚ŞŽ¸”s‚ľ‚Ü‚ľ‚˝ ‰ńü‚âƒvƒƒLƒV‚̏ó‘Ԃ𒲂ׂĂ­‚ž‚ł‚˘');
138     MessageMemo.Lines.Add('Message: ' + E.Message);
139     end;
140     on E: Exception do begin
141     if FAbort then
142     MessageMemo.Lines.Add('ƒ_ƒEƒ“ƒ[ƒh‚đ’†’f‚ľ‚Ü‚ľ‚˝')
143     else begin
144     MessageMemo.Lines.Add('ƒ_ƒEƒ“ƒ[ƒh‚ŞŽ¸”s‚ľ‚Ü‚ľ‚˝');
145     MessageMemo.Lines.Add('ResponseCode: ' + IntToStr(Indy.ResponseCode));
146     MessageMemo.Lines.Add('Message: ' + E.Message);
147     MessageMemo.Lines.Add('------------------------');
148     for i := 0 to Indy.Response.RawHeaders.Count - 1 do begin
149     s := Indy.Response.RawHeaders.Names[i];
150     s := s + ': ' + Indy.Response.RawHeaders.Values[s];
151     MessageMemo.Lines.Add(s);
152     end;
153     MessageMemo.Lines.Add('------------------------');
154     end;
155     end;
156     end;
157     Result.FResponseCode := Indy.ResponseCode;
158     finally
159     Stream.Free;
160     end;
161     end;
162    
163     procedure TNewBoardDialog.UpdateURL(s: string);
164     var
165     i: Integer;
166     idx: Integer;
167     idx1: Integer;
168     idx2: Integer;
169     tmp: string;
170     URL: string;
171     Title: string;
172     cate: string;
173     Board: TBoard;
174     Change: Boolean;
175     ini: TMemIniFile;
176     begin
177     Change := False;
178     MessageMemo.Lines.Add('V”A”ÂURL•ύXƒ`ƒFƒbƒN‚đŠJŽn‚ľ‚Ü‚ˇ');
179     MessageMemo.Lines.Add('');
180     s := StringReplace(s, '<B>', '<b>', [rfReplaceAll, rfIgnoreCase]);
181     s := StringReplace(s, '<BR>', '<br>', [rfReplaceAll, rfIgnoreCase]);
182     s := StringReplace(s, '</B>', '</b>', [rfReplaceAll, rfIgnoreCase]);
183     s := StringReplace(s, '<A HREF', '<a href', [rfReplaceAll, rfIgnoreCase]);
184     s := StringReplace(s, '</A', '</a', [rfReplaceAll, rfIgnoreCase]);
185     cate := '';
186     GikoSys.ForceDirectoriesEx(GikoSys.GetConfigDir);
187     ini := TMemIniFile.Create(GikoSys.GetBoardFileName);
188     try
189     //
190     //íœƒIƒvƒVƒ‡ƒ“‚Ş‘I‘đ‚ł‚ę‚Ä‚˘‚éę‡‚̓NƒŠƒA
191    
192     ini.Clear;
193     while True do begin
194     idx1 := AnsiPos('<b>', s);
195     idx2 := AnsiPos('<a', s);
196     if (idx1 = 0) and (idx2 = 0) then Break;
197    
198     if idx1 < idx2 then begin
199     //<br>
200     idx := AnsiPos('</b>', s);
201     if idx = 0 then begin
202     s := Copy(s, idx1 + 4, Length(s));
203     continue;
204     end;
205     tmp := Copy(s, idx1, (idx - idx1) + 4);
206     tmp := StringReplace(tmp, '<b>', '', [rfReplaceAll]);
207     tmp := StringReplace(tmp, '</b>', '', [rfReplaceAll]);
208    
209     if (tmp = '‚¨‚ˇ‚ˇ‚ß') or
210     (tmp = '“Á•ĘŠé‰ć') or
211     (tmp = '‚Ü‚ż‚a‚a‚r') or
212     (tmp = 'ƒ`ƒƒƒbƒg') or
213     (tmp = '‚¨ŠG‚Š‚Ť') or
214     (tmp = '‰^‰c') or
215     (tmp = 'ƒc[ƒ‹—Ţ') or
216     (tmp = '‘ź‚ĚƒTƒCƒg') then begin
217     cate := '';
218     s := Copy(s, idx + 5, Length(s));
219     Continue;
220     end;
221     s := Copy(s, idx + 5, Length(s));
222     cate := tmp;
223     end else begin
224     //<a href=
225     if cate = '' then begin
226     s := Copy(s, idx2 + 2, Length(s));
227     end else begin
228     idx := AnsiPos('</a>', s);
229     tmp := Copy(s, idx2, (idx - idx2) + 4);
230     tmp := StringReplace(tmp, '<a href=', '', [rfReplaceAll]);
231     tmp := StringReplace(tmp, '</a>', '', [rfReplaceAll]);
232     i := AnsiPos('>', tmp);
233     if i <> 0 then begin
234     URL := Copy(tmp, 1, i - 1);
235     Title := Copy(tmp, i + 1, Length(tmp));
236     Board := BBS2ch.FindBoardFromTitle(Title);
237     if Board = nil then begin
238     MessageMemo.Lines.Add('V”’ljÁu' + Title + '(' + URL + ')v');
239     ini.WriteString(cate, Title, URL);
240     Change := True;
241     end else begin
242     if Board.URL <> URL then begin
243     MessageMemo.Lines.Add('URL•ύXu' + Board.Title + '(' + URL +')v');
244     ini.WriteString(cate, Title, URL);
245     Change := True;
246     end else begin
247     ini.WriteString(cate, Title, URL);
248     end;
249     end;
250     end else begin
251     s := Copy(s, idx2 + 2, Length(s));
252     Continue;
253     end;
254     s := Copy(s, idx + 5, Length(s));
255     end;
256     end;
257     end;
258     finally
259     if Change then
260     ini.UpdateFile;
261     ini.Free;
262     end;
263     MessageMemo.Lines.Add('');
264     if Change then begin
265     MessageMemo.Lines.Add('V”A”ÂURL•ύXƒ`ƒFƒbƒN‚ŞŠŽ—š‚ľ‚Ü‚ľ‚˝');
266     MessageMemo.Lines.Add('u•‚ś‚évƒ{ƒ^ƒ“‚đ‰Ÿ‚ľ‚Ä‚­‚ž‚ł‚˘');
267     end else
268     MessageMemo.Lines.Add('V”A”ÂURL•ύX‚Í ‚ ‚č‚Ü‚š‚ń‚Ĺ‚ľ‚˝');
269     end;
270    
271     procedure TNewBoardDialog.FormCreate(Sender: TObject);
272     begin
273     StopButton.Enabled := False;
274     end;
275    
276     end.

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