6 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7 Dialogs, IdAntiFreezeBase, IdAntiFreeze, IdBaseComponent, IdComponent,
8 IdTCPConnection, IdTCPClient, IdHTTP, StdCtrls,
12 TNewBoardURLForm = class(TForm)
13 CategoryComboBox: TComboBox;
14 CategoryLabel: TLabel;
16 IdAntiFreeze: TIdAntiFreeze;
17 SearchButton: TButton;
20 procedure FormCreate(Sender: TObject);
21 procedure SearchButtonClick(Sender: TObject);
22 procedure IdHTTPRedirect(Sender: TObject; var dest: String;
23 var NumRedirect: Integer; var Handled: Boolean;
24 var VMethod: TIdHTTPMethod);
27 function GetRedirectURL(const html: string): string;
28 procedure GetBoardURLs(urls : TStringList);
29 procedure ReplaceURLs(oldurls, newurls: TStringList);
35 NewBoardURLForm: TNewBoardURLForm;
40 GikoSystem, NewBoard, Giko, IniFiles, MojuUtils, GikoDataModule;
42 //!
\83R
\83\93\83X
\83g
\83\89\83N
\83^
43 procedure TNewBoardURLForm.FormCreate(Sender: TObject);
49 sec := TStringList.Create;
51 ini := TMemIniFile.Create(GikoSys.GetBoardFileName);
53 ini.ReadSections(sec);
55 CategoryComboBox.Clear;
56 CategoryComboBox.Items.BeginUpdate;
57 for i := 0 to sec.Count - 1 do begin
58 CategoryComboBox.Items.Add(sec[i]);
60 CategoryComboBox.Items.EndUpdate;
61 CategoryComboBox.ItemIndex := 0;
63 ResultMemo.Lines.Clear;
65 if ini <> nil then begin
70 if sec <> nil then begin
75 //!
\8c\9f\8dõ
\83{
\83^
\83\93\83C
\83x
\83\93\83g
76 procedure TNewBoardURLForm.SearchButtonClick(Sender: TObject);
80 ResStream: TMemoryStream;
82 oldURLs : TStringList;
83 newURLs : TStringList;
84 oldURL, newURL : string;
85 TabURLs : TStringList;
87 ResultMemo.Lines.Clear;
88 URLs := TStringList.Create;
89 Screen.Cursor := crHourGlass;
90 SearchButton.Enabled := False;
93 if URLs.Count > 0 then begin
94 ResStream := TMemoryStream.Create;
95 oldURLs := TStringList.Create;
96 newURLs := TStringList.Create;
99 TNewBoardDialog.InitHTTPClient(IdHTTP);
100 IdHTTP.Request.Referer := '';
101 IdHTTP.Request.AcceptEncoding := 'gzip';
103 IdHTTP.Request.CacheControl := 'no-cache';
104 IdHTTP.Request.CustomHeaders.Add('Pragma: no-cache');
105 IdHTTP.HandleRedirects := false;
106 IdAntiFreeze.Active := true;
107 for i := 0 to URLs.Count - 1 do begin
110 IdHTTP.Get(URLs[i], ResStream);
111 value := GikoSys.GzipDecompress(ResStream,
112 IdHTTP.Response.ContentEncoding);
113 newURL := GetRedirectURL(value);
114 if (newURL = '') then begin
115 newURL := IdHTTP.Response.Location;
117 if (newURL <> '') then begin
118 //
\83\8a\83_
\83C
\83\8c\83N
\83g
\82·
\82ê
\82Î
\95K
\82¸
\88Ú
\93]
\82Æ
\82Í
\8cÀ
\82ç
\82È
\82¢
119 //
\83e
\83\8c\83r
\94Ô
\91g
\94Â
\82È
\82Ç
\82Ì
\91Î
\8dô
\8dÅ
\8cã
\82Ì'/'
\82Ü
\82Å
\82ðURL
\82Æ
\82·
\82é
120 if (Length(newURL) <> LastDelimiter('/', newURL)) then begin
121 newURL := Copy(newURL, 1, LastDelimiter('/', newURL));
124 if (oldURL <> newURL) then begin
125 ResultMemo.Lines.Add('URL:' + oldURL + ' -> ' + newURL);
126 oldURLs.Add( oldURL );
127 newURLs.Add( newURL );
131 on E: Exception do begin
133 Writeln(IdHTTP.ResponseText);
138 IdAntiFreeze.Active := false;
139 if (newURLs.Count > 0) and (oldURLs.Count > 0) then begin
140 ReplaceURLs(oldURLs, newURLs);
141 GikoForm.FavoritesURLReplace(oldURLs, newURLs);
142 GikoForm.RoundListURLReplace(oldURLs, newURLs);
143 GikoForm.TabFileURLReplace(oldURLs, newURLs);
144 ResultMemo.Lines.Add('
\94Â
\88Ú
\93]
\90æ
\8c\9f\8dõ
\82ª
\8a®
\97¹
\82µ
\82Ü
\82µ
\82½');
146 TabURLs := TStringList.Create;
148 GikoDM.GetTabURLs(TabURLs);
150 GikoDM.OpenURLs(TabURLs);
156 ResultMemo.Lines.Add('
\88Ú
\93]
\82µ
\82Ä
\82¢
\82é
\94Â
\82Í
\82 \82è
\82Ü
\82¹
\82ñ
\82Å
\82µ
\82½');
167 SearchButton.Enabled := True;
168 Screen.Cursor := crDefault;
171 function TNewBoardURLForm.GetRedirectURL(const html: string): string;
175 SCRIPT = 'window.location.href="';
177 Result := Copy(html, 1,
178 AnsiPos(HEADE, AnsiLowerCase(html)));
179 Result := Copy(Result,
180 AnsiPos(HEADS, AnsiLowerCase(Result)),
182 if AnsiPos(SCRIPT, Result) > 0 then begin
183 Result := Copy(Result, AnsiPos(SCRIPT, Result) + Length(SCRIPT),
185 Result := Copy(Result, 1, AnsiPos('"', Result) - 1);
191 procedure TNewBoardURLForm.GetBoardURLs(urls : TStringList);
200 if CategoryComboBox.ItemIndex <> -1 then begin
201 sec := CategoryComboBox.Items[CategoryComboBox.itemIndex];
202 keys := TStringList.Create;
204 ini := TMemIniFile.Create(GikoSys.GetBoardFileName);
206 ini.ReadSection(sec, keys);
207 for i := 0 to keys.Count - 1 do begin
208 urls.Add(ini.ReadString(sec, keys[i], ''));
218 procedure TNewBoardURLForm.ReplaceURLs(oldurls, newurls: TStringList);
223 if oldurls.Count > 0 then begin
224 txt := TStringList.Create;
225 txt.LoadFromFile( GikoSys.GetBoardFileName );
227 for i := 0 to oldurls.Count - 1 do begin
228 MojuUtils.CustomStringReplace(txt, oldurls[i], newurls[i]);
230 txt.SaveToFile( GikoSys.GetBoardFileName );
237 procedure TNewBoardURLForm.IdHTTPRedirect(Sender: TObject;
238 var dest: String; var NumRedirect: Integer; var Handled: Boolean;
239 var VMethod: TIdHTTPMethod);