• R/O
  • HTTP
  • SSH
  • HTTPS

Commit

Tags
No Tags

Frequently used words (click to add to your profile)

javaandroidc++linuxc#objective-ccocoa誰得qtrubypythongamewindowsbathyscaphephpguic翻訳omegattwitterframeworktestbtronarduinovb.net計画中(planning stage)directxpreviewerゲームエンジンdom

ギコナビ


Commit MetaInfo

Revisionc686d46f57a6b821498dc64cd3b07ec87d4df42a (tree)
Time2007-01-04 22:11:38
Authorh677 <h677>
Commiterh677

Log Message

移転した板のURLを検索する機能を追加

Change Summary

Incremental Difference

--- a/Giko.dfm
+++ b/Giko.dfm
@@ -159,7 +159,7 @@ object GikoForm: TGikoForm
159159 object ToolBar1: TToolBar
160160 Left = 2
161161 Top = 4
162- Width = 15
162+ Width = 16
163163 Height = 18
164164 Align = alNone
165165 AutoSize = True
@@ -971,7 +971,7 @@ object GikoForm: TGikoForm
971971 OnResize = AddressToolBarResize
972972 object AddressComboBox: TComboBox
973973 Left = 0
974- Top = 0
974+ Top = 1
975975 Width = 177
976976 Height = 20
977977 DropDownCount = 20
@@ -4478,6 +4478,9 @@ object GikoForm: TGikoForm
44784478 object B4: TMenuItem
44794479 Action = GikoDM.NewBoardAction
44804480 end
4481+ object N80: TMenuItem
4482+ Action = GikoDM.NewBoardSearchAction
4483+ end
44814484 object N7: TMenuItem
44824485 Caption = '-'
44834486 end
--- a/Giko.pas
+++ b/Giko.pas
@@ -416,6 +416,7 @@ type
416416 N79: TMenuItem;
417417 HTML1: TMenuItem;
418418 DAT4: TMenuItem;
419+ N80: TMenuItem;
419420 procedure FormCreate(Sender: TObject);
420421 procedure FormDestroy(Sender: TObject);
421422 procedure BrowserStatusTextChange(Sender: TObject;
--- a/GikoDataModule.dfm
+++ b/GikoDataModule.dfm
@@ -1305,6 +1305,12 @@ object GikoDM: TGikoDM
13051305 Hint = #12450#12489#12524#12473#12496#12540#12395#12501#12457#12540#12459#12473#12434#24403#12390#12427
13061306 OnExecute = SetForcusForAddresBarActionExecute
13071307 end
1308+ object NewBoardSearchAction: TAction
1309+ Category = #12501#12449#12452#12523
1310+ Caption = #31227#36578#26495#26908#32034
1311+ Hint = #31227#36578#12375#12390#12356#12427#26495#12398'URL'#12434#26908#32034#12377#12427
1312+ OnExecute = NewBoardSearchActionExecute
1313+ end
13081314 end
13091315 object ToobarImageList: TImageList
13101316 Left = 44
--- a/GikoDataModule.pas
+++ b/GikoDataModule.pas
@@ -230,6 +230,7 @@ type
230230 AllImageLinkToClipbordAction: TAction;
231231 NewImageLinkToClipBoardAction: TAction;
232232 SetForcusForAddresBarAction: TAction;
233+ NewBoardSearchAction: TAction;
233234 procedure EditNGActionExecute(Sender: TObject);
234235 procedure ReloadActionExecute(Sender: TObject);
235236 procedure GoFowardActionExecute(Sender: TObject);
@@ -432,6 +433,7 @@ type
432433 procedure NewImageLinkToClipBoardActionExecute(Sender: TObject);
433434 procedure AllImageLinkToClipbordActionExecute(Sender: TObject);
434435 procedure SetForcusForAddresBarActionExecute(Sender: TObject);
436+ procedure NewBoardSearchActionExecute(Sender: TObject);
435437 private
436438 { Private éŒ¾ }
437439 procedure ClearResFilter;
@@ -484,7 +486,7 @@ uses
484486 GikoBayesian, About, ShellAPI,
485487 RoundName, RoundData, Menus, ListViewUtils,
486488 ThreadControl, GikoMessage, InputAssist,
487- DefaultFileManager, Forms;
489+ DefaultFileManager, Forms, NewBoardURL;
488490
489491 const
490492 MSG_ERROR : string = 'ƒGƒ‰[';
@@ -4313,6 +4315,26 @@ begin
43134315 GikoForm.AddressComboBox.SetFocus;
43144316 end
43154317 end;
4318+{
4319+\brief ˆÚ“]‚µ‚½”‚ÌURL‚ðŽæ“¾‚·‚éƒ_ƒCƒAƒOƒ‰ƒ€‚ð•\Ž¦‚·‚é
4320+}
4321+procedure TGikoDM.NewBoardSearchActionExecute(Sender: TObject);
4322+var
4323+ form : TNewBoardURLForm;
4324+ Msg: string;
4325+begin
4326+ if (EditorFormExists) then begin
4327+ Msg := 'ƒŒƒXƒGƒfƒBƒ^‚ð‘S‚ĕ‚¶‚Ä‚­‚¾‚³‚¢';
4328+ MsgBox(GikoForm.Handle, Msg, MSG_ERROR, MB_OK or MB_ICONSTOP);
4329+ Exit;
4330+ end;
4331+ form := TNewBoardURLForm.Create(Self);
4332+ try
4333+ form.ShowModal;
4334+ finally
4335+ form.Release;
4336+ end;
4337+end;
43164338
43174339 end.
43184340
--- a/NewBoard.dfm
+++ b/NewBoard.dfm
@@ -1,6 +1,6 @@
11 object NewBoardDialog: TNewBoardDialog
2- Left = 276
3- Top = 325
2+ Left = 337
3+ Top = 197
44 BorderStyle = bsDialog
55 Caption = #26495#19968#35239#26356#26032
66 ClientHeight = 329
--- a/NewBoard.pas
+++ b/NewBoard.pas
@@ -44,6 +44,7 @@ type
4444 procedure UpdateIgnoreList(Sender: TObject);
4545 public
4646 { Public éŒ¾ }
47+ class procedure InitHTTPClient(client : TIdHTTP);
4748 end;
4849
4950 var
@@ -119,32 +120,8 @@ var
119120 s: string;
120121 i: Integer;
121122 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;
123+ InitHTTPClient( Indy );
124+
148125 Indy.Request.UserAgent := GikoSys.GetUserAgent;
149126 Indy.Request.Referer := '';
150127 Indy.Request.AcceptEncoding := 'gzip';
@@ -433,4 +410,33 @@ begin
433410 end;
434411 end;
435412 end;
413+
414+class procedure TNewBoardDialog.InitHTTPClient(client : TIdHTTP);
415+begin
416+ client.Request.Clear;
417+ client.Request.CustomHeaders.Clear;
418+ client.RecvBufferSize := Gikosys.Setting.RecvBufferSize;
419+ client.ProxyParams.BasicAuthentication := False;
420+ if GikoSys.Setting.ReadProxy then begin
421+ if GikoSys.Setting.ProxyProtocol then
422+ client.ProtocolVersion := pv1_1
423+ else
424+ client.ProtocolVersion := pv1_0;
425+ client.ProxyParams.ProxyServer := GikoSys.Setting.ReadProxyAddress;
426+ client.ProxyParams.ProxyPort := GikoSys.Setting.ReadProxyPort;
427+ client.ProxyParams.ProxyUsername := GikoSys.Setting.ReadProxyUserID;
428+ client.ProxyParams.ProxyPassword := GikoSys.Setting.ReadProxyPassword;
429+ if GikoSys.Setting.ReadProxyUserID <> '' then
430+ client.ProxyParams.BasicAuthentication := True;
431+ end else begin
432+ if GikoSys.Setting.Protocol then
433+ client.ProtocolVersion := pv1_1
434+ else
435+ client.ProtocolVersion := pv1_0;
436+ client.ProxyParams.ProxyServer := '';
437+ client.ProxyParams.ProxyPort := 80;
438+ client.ProxyParams.ProxyUsername := '';
439+ client.ProxyParams.ProxyPassword := '';
440+ end;
441+end;
436442 end.
--- /dev/null
+++ b/NewBoardURL.dfm
@@ -0,0 +1,84 @@
1+object NewBoardURLForm: TNewBoardURLForm
2+ Left = 380
3+ Top = 187
4+ Width = 495
5+ Height = 313
6+ Caption = #26495#31227#36578#20808#26908#32034
7+ Color = clBtnFace
8+ Font.Charset = SHIFTJIS_CHARSET
9+ Font.Color = clWindowText
10+ Font.Height = -12
11+ Font.Name = #65325#65331' '#65328#12468#12471#12483#12463
12+ Font.Style = []
13+ FormStyle = fsStayOnTop
14+ OldCreateOrder = False
15+ OnCreate = FormCreate
16+ PixelsPerInch = 96
17+ TextHeight = 12
18+ object CategoryLabel: TLabel
19+ Left = 24
20+ Top = 16
21+ Width = 53
22+ Height = 12
23+ Caption = #12459#12486#12468#12522#21517
24+ end
25+ object CategoryComboBox: TComboBox
26+ Left = 88
27+ Top = 13
28+ Width = 145
29+ Height = 20
30+ ItemHeight = 12
31+ TabOrder = 0
32+ Text = 'CategoryComboBox'
33+ end
34+ object SearchButton: TButton
35+ Left = 256
36+ Top = 8
37+ Width = 75
38+ Height = 25
39+ Caption = #26908#32034'(&s)'
40+ TabOrder = 1
41+ OnClick = SearchButtonClick
42+ end
43+ object ResultMemo: TMemo
44+ Left = 24
45+ Top = 48
46+ Width = 457
47+ Height = 225
48+ Lines.Strings = (
49+ 'ResultMemo')
50+ ScrollBars = ssVertical
51+ TabOrder = 2
52+ end
53+ object CloseButton: TButton
54+ Left = 352
55+ Top = 8
56+ Width = 75
57+ Height = 25
58+ Caption = #38281#12376#12427
59+ ModalResult = 1
60+ TabOrder = 3
61+ end
62+ object IdHTTP: TIdHTTP
63+ MaxLineAction = maException
64+ AllowCookies = True
65+ HandleRedirects = True
66+ ProxyParams.BasicAuthentication = False
67+ ProxyParams.ProxyPort = 0
68+ Request.ContentLength = -1
69+ Request.ContentRangeEnd = 0
70+ Request.ContentRangeStart = 0
71+ Request.Accept = 'text/html, */*'
72+ Request.BasicAuthentication = False
73+ Request.UserAgent = 'Mozilla/3.0 (compatible; Indy Library)'
74+ HTTPOptions = [hoForceEncodeParams]
75+ OnRedirect = IdHTTPRedirect
76+ Left = 408
77+ Top = 16
78+ end
79+ object IdAntiFreeze: TIdAntiFreeze
80+ Active = False
81+ Left = 448
82+ Top = 16
83+ end
84+end
--- /dev/null
+++ b/NewBoardURL.pas
@@ -0,0 +1,226 @@
1+unit NewBoardURL;
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, StdCtrls,
9+ BoardGroup;
10+
11+type
12+ TNewBoardURLForm = class(TForm)
13+ CategoryComboBox: TComboBox;
14+ CategoryLabel: TLabel;
15+ IdHTTP: TIdHTTP;
16+ IdAntiFreeze: TIdAntiFreeze;
17+ SearchButton: TButton;
18+ ResultMemo: TMemo;
19+ CloseButton: 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);
25+ private
26+ { Private éŒ¾ }
27+ function GetRedirectURL(const html: string): string;
28+ procedure GetBoardURLs(urls : TStringList);
29+ procedure ReplaceURLs(oldurls, newurls: TStringList);
30+ public
31+ { Public éŒ¾ }
32+ end;
33+
34+var
35+ NewBoardURLForm: TNewBoardURLForm;
36+
37+implementation
38+
39+uses
40+ GikoSystem, NewBoard, Giko, IniFiles, MojuUtils, GikoDataModule;
41+{$R *.dfm}
42+//! ƒRƒ“ƒXƒgƒ‰ƒNƒ^
43+procedure TNewBoardURLForm.FormCreate(Sender: TObject);
44+var
45+ i : Integer;
46+ ini : TMemIniFile;
47+ sec : TStringList;
48+begin
49+ sec := TStringList.Create;
50+ ini := TMemIniFile.Create(GikoSys.GetBoardFileName);
51+ ini.ReadSections(sec);
52+
53+ CategoryComboBox.Clear;
54+ CategoryComboBox.Items.BeginUpdate;
55+ for i := 0 to sec.Count - 1 do begin
56+ CategoryComboBox.Items.Add(sec[i]);
57+ end;
58+ CategoryComboBox.Items.EndUpdate;
59+ CategoryComboBox.ItemIndex := 0;
60+
61+ ResultMemo.Lines.Clear;
62+end;
63+
64+procedure TNewBoardURLForm.SearchButtonClick(Sender: TObject);
65+var
66+ i : Integer;
67+ value : string;
68+ ResStream: TMemoryStream;
69+ URLs : TStringList;
70+ oldURLs : TStringList;
71+ newURLs : TStringList;
72+ oldURL, newURL : string;
73+ TabURLs : TStringList;
74+begin
75+ ResultMemo.Lines.Clear;
76+ URLs := TStringList.Create;
77+ Screen.Cursor := crHourGlass;
78+ SearchButton.Enabled := False;
79+ try
80+ GetBoardURLs( URLs );
81+ if URLs.Count > 0 then begin
82+ ResStream := TMemoryStream.Create;
83+ oldURLs := TStringList.Create;
84+ newURLs := TStringList.Create;
85+
86+ try
87+ TNewBoardDialog.InitHTTPClient(IdHTTP);
88+ IdHTTP.Request.Referer := '';
89+ IdHTTP.Request.AcceptEncoding := 'gzip';
90+
91+ IdHTTP.Request.CacheControl := 'no-cache';
92+ IdHTTP.Request.CustomHeaders.Add('Pragma: no-cache');
93+ IdHTTP.HandleRedirects := false;
94+ for i := 0 to URLs.Count - 1 do begin
95+ IdAntiFreeze.Active := true;
96+ try
97+ ResStream.Clear;
98+ IdHTTP.Get(URLs[i], ResStream);
99+ value := GikoSys.GzipDecompress(ResStream,
100+ IdHTTP.Response.ContentEncoding);
101+ newURL := GetRedirectURL(value);
102+ if (newURL = '') then begin
103+ newURL := IdHTTP.Response.Location;
104+ end;
105+ if (newURL <> '') then begin
106+ oldURL := URLs[i];
107+ ResultMemo.Lines.Add('URL:' + oldURL + ' -> ' + newURL);
108+ if (newURL <> '') then begin
109+ oldURLs.Add( oldURL );
110+ newURLs.Add( newURL );
111+ end;
112+ end;
113+ except
114+ on E: Exception do begin
115+ {$IFDEF DEBUG}
116+ Writeln(IdHTTP.ResponseText);
117+ {$ENDIF}
118+ end;
119+ end;
120+ IdAntiFreeze.Active := false;
121+ end;
122+
123+ if (newURLs.Count > 0) and (oldURLs.Count > 0) then begin
124+ ReplaceURLs(oldURLs, newURLs);
125+ GikoForm.FavoritesURLReplace(oldURLs, newURLs);
126+ GikoForm.RoundListURLReplace(oldURLs, newURLs);
127+ GikoForm.TabFileURLReplace(oldURLs, newURLs);
128+ ResultMemo.Lines.Add('”ˆړ]æŒŸõ‚ªŠ®—¹‚µ‚Ü‚µ‚½');
129+
130+ TabURLs := TStringList.Create;
131+ try
132+ GikoDM.GetTabURLs(TabURLs);
133+ GikoForm.ReloadBBS;
134+ GikoDM.OpenURLs(TabURLs);
135+ finally
136+ TabURLs.Free;
137+ end;
138+
139+ end else begin
140+ ResultMemo.Lines.Add('ˆÚ“]‚µ‚Ä‚¢‚é”Â‚Í ‚ ‚è‚Ü‚¹‚ñ‚Å‚µ‚½');
141+ end;
142+ finally
143+ ResStream.Clear;
144+ ResStream.Free;
145+ newURLs.Free;
146+ oldURLs.Free;
147+ end;
148+ end;
149+ finally
150+ URLs.Free;
151+ SearchButton.Enabled := True;
152+ Screen.Cursor := crDefault;
153+ end;
154+end;
155+function TNewBoardURLForm.GetRedirectURL(const html: string): string;
156+const
157+ HEADS = '<head>';
158+ HEADE = '</head>';
159+ SCRIPT = 'window.location.href="';
160+begin
161+ Result := Copy(html, 1,
162+ AnsiPos(HEADE, AnsiLowerCase(html)));
163+ Result := Copy(Result,
164+ AnsiPos(HEADS, AnsiLowerCase(Result)),
165+ Length(Result));
166+ if AnsiPos(SCRIPT, Result) > 0 then begin
167+ Result := Copy(Result, AnsiPos(SCRIPT, Result) + Length(SCRIPT),
168+ Length(Result));
169+ Result := Copy(Result, 1, AnsiPos('"', Result) - 1);
170+ end else begin
171+ Result := '';
172+ end;
173+
174+end;
175+procedure TNewBoardURLForm.GetBoardURLs(urls : TStringList);
176+var
177+ ini : TMemIniFile;
178+ sec : string;
179+ keys : TStringList;
180+ i : Integer;
181+begin
182+ urls.Clear;
183+ urls.BeginUpdate;
184+ if CategoryComboBox.ItemIndex <> -1 then begin
185+ sec := CategoryComboBox.Items[CategoryComboBox.itemIndex];
186+ keys := TStringList.Create;
187+ try
188+ ini := TMemIniFile.Create(GikoSys.GetBoardFileName);
189+ ini.ReadSection(sec, keys);
190+ for i := 0 to keys.Count - 1 do begin
191+ urls.Add(ini.ReadString(sec, keys[i], ''));
192+ end;
193+ finally
194+ keys.Free;
195+ end;
196+ end;
197+end;
198+procedure TNewBoardURLForm.ReplaceURLs(oldurls, newurls: TStringList);
199+var
200+ txt : TStringList;
201+ i : Integer;
202+begin
203+ if oldurls.Count > 0 then begin
204+ txt := TStringList.Create;
205+ txt.LoadFromFile( GikoSys.GetBoardFileName );
206+ try
207+ for i := 0 to oldurls.Count - 1 do begin
208+ MojuUtils.CustomStringReplace(txt, oldurls[i], newurls[i]);
209+ end;
210+ txt.SaveToFile( GikoSys.GetBoardFileName );
211+ finally
212+ txt.Free;
213+ end;
214+ end;
215+end;
216+
217+procedure TNewBoardURLForm.IdHTTPRedirect(Sender: TObject;
218+ var dest: String; var NumRedirect: Integer; var Handled: Boolean;
219+ var VMethod: TIdHTTPMethod);
220+begin
221+ {$IFDEF DEBUG}
222+ ShowMessage(dest);
223+ {$ENDIF}
224+end;
225+
226+end.
--- a/gikoNavi.dpr
+++ b/gikoNavi.dpr
@@ -75,7 +75,8 @@ uses
7575 DefaultFileManager in 'DefaultFileManager.pas',
7676 MoveHistoryItem in 'MoveHistoryItem.pas',
7777 SambaTimer in 'SambaTimer.pas',
78- HistoryList in 'HistoryList.pas';
78+ HistoryList in 'HistoryList.pas',
79+ NewBoardURL in 'NewBoardURL.pas' {NewBoardURLForm};
7980
8081 {$R *.RES}
8182 {$R gikoResource.res}
Binary files a/gikoNavi.res and b/gikoNavi.res differ