Commit MetaInfo

Revision4fdaae09a384d8c0b1a49b6314f854c238d9b951 (tree)
Zeit2008-09-14 10:47:49
Autorcvs2git <cvs2git>
Commitercvs2git

Log Message

This commit was manufactured by cvs2svn to create tag 'v1_58_0_754'.

Ändern Zusammenfassung

Diff

--- a/BoardGroup.pas
+++ b/BoardGroup.pas
@@ -334,12 +334,6 @@ type
334334 property BoardPlugIn : TBoardPlugIn read FBoardPlugIn write FBoardPlugIn;
335335 end;
336336
337- // 特殊用途用TBoard
338- TSpecialBoard = class(TBoard)
339- public
340- function Add(item: TThreadItem): integer; overload;
341- procedure Clear; overload;
342- end;
343337
344338 function BBSsFindBoardFromBBSID( inBBSID : string ) : TBoard;
345339 function BBSsFindBoardFromURL( inURL : string ) : TBoard;
@@ -347,13 +341,9 @@ type
347341 function BBSsFindThreadFromURL(const inURL : string ) : TThreadItem;
348342 function ConvertDateTimeString( inDateTimeString : string) : TDateTime;
349343
350- procedure DestorySpecialBBS( inBBS : TBBS );
351-
352344 var
353345 BBSs : array of TBBS;
354346 BoardGroups : array of TBoardGroup;
355- SpecialBBS : TBBS;
356- SpecialBoard: TSpecialBoard;
357347
358348 implementation
359349
@@ -539,28 +529,6 @@ begin
539529 end;
540530
541531 end;
542-{!
543-\brief 特殊用途BBS削除
544-\param bbs 削除する特殊用途BBS
545-}
546-procedure DestorySpecialBBS( inBBS : TBBS );
547-var
548- sCategory : TCategory;
549- sBoard : TSpecialBoard;
550-begin
551- if inBBS <> nil then begin
552- sCategory := inBBS.Items[0];
553- if sCategory <> nil then begin
554- sBoard := TSpecialBoard(sCategory.Items[0]);
555- if sBoard <> nil then begin
556- sBoard.Modified := False;
557- sBoard.Clear;
558- FreeAndNil(sBoard);
559- end;
560- end;
561- FreeAndNil(inBBS);
562- end;
563-end;
564532
565533 (*************************************************************************
566534 *機能名:TBBSコンストラクタ
@@ -1862,19 +1830,6 @@ begin
18621830
18631831 end;
18641832
1865-function TSpecialBoard.Add(item: TThreadItem): integer;
1866-begin
1867- Result := inherited AddObject(Item.URL, Item);
1868-end;
1869-
1870-procedure TSpecialBoard.Clear;
1871-var
1872- i: integer;
1873-begin
1874- for i := Count - 1 downto 0 do
1875- DeleteList(i);
1876- Capacity := 0;
1877-end;
18781833
18791834 end.
18801835
--- a/Giko.dfm
+++ b/Giko.dfm
@@ -8397,9 +8397,6 @@ object GikoForm: TGikoForm
83978397 object ID1: TMenuItem
83988398 Action = GikoDM.SameIDResAnchorAction
83998399 end
8400- object N83: TMenuItem
8401- Action = GikoDM.DereferenceResAction
8402- end
84038400 end
84048401 object BrowserTabPopupMenu: TPopupMenu
84058402 Images = HotToobarImageList
@@ -8753,11 +8750,4 @@ object GikoForm: TGikoForm
87538750 Left = 8
87548751 Top = 440
87558752 end
8756- object TaskTrayPopupMenu: TPopupMenu
8757- Left = 38
8758- Top = 373
8759- object Exit1: TMenuItem
8760- Action = GikoDM.ExitAction
8761- end
8762- end
87638753 end
--- a/Giko.pas
+++ b/Giko.pas
@@ -417,9 +417,6 @@ type
417417 IDNG1: TMenuItem;
418418 IDNG2: TMenuItem;
419419 ResPopupClearTimer: TTimer;
420- TaskTrayPopupMenu: TPopupMenu;
421- Exit1: TMenuItem;
422- N83: TMenuItem;
423420 procedure FormCreate(Sender: TObject);
424421 procedure FormDestroy(Sender: TObject);
425422 procedure BrowserStatusTextChange(Sender: TObject;
@@ -692,9 +689,6 @@ type
692689 function isValidFile(FileName: String) : boolean;
693690 //! ListViewのD&D受け取り
694691 procedure AcceptDropFiles(var Msg: TMsg);
695- //! スレッド一覧更新処理
696- procedure UpdateListView();
697-
698692 protected
699693 procedure CreateParams(var Params: TCreateParams); override;
700694 procedure WndProc(var Message: TMessage); override;
@@ -821,8 +815,6 @@ type
821815 procedure TaskTrayIconMessage(var Msg : TMsg); message WM_USER + 2010;
822816 //! タスクトレイにアイコン登録&フォーム隠し
823817 procedure StoredTaskTray;
824- //! 同IDレスアンカー表示
825- procedure ShowSameIDAncher(const AID: String);
826818 published
827819 property EnabledCloseButton: Boolean read FEnabledCloseButton write SetEnabledCloseButton;
828820 end;
@@ -1553,13 +1545,8 @@ var
15531545 i : Integer;
15541546 wp : TWindowPlacement;
15551547 tmpBool : Boolean;
1556- WindowPlacement: TWindowPlacement;
1548+ doc:IHTMLDocument2;
15571549 begin
1558- // タスクトレイのアイコン削除
1559- if (FIconData.uID <> 0) then begin
1560- Shell_NotifyIcon(NIM_DELETE, @FIconData);
1561- end;
1562-
15631550 // マウスジェスチャー開放
15641551 try
15651552 if GikoSys.Setting.GestureEnabled then begin
@@ -1577,9 +1564,6 @@ begin
15771564 except
15781565 end;
15791566 try
1580- WindowPlacement.length := SizeOf(TWindowPlacement);
1581- GetWindowPlacement(Self.Handle, @WindowPlacement);
1582-
15831567 //最大化・ウィンドウ位置保存
15841568 wp.length := sizeof(wp);
15851569 GetWindowPlacement(Handle, @wp);
@@ -1587,8 +1571,8 @@ begin
15871571 GikoSys.Setting.WindowLeft := wp.rcNormalPosition.Left;
15881572 GikoSys.Setting.WindowHeight := wp.rcNormalPosition.Bottom - wp.rcNormalPosition.Top;
15891573 GikoSys.Setting.WindowWidth := wp.rcNormalPosition.Right - wp.rcNormalPosition.Left;
1590- GikoSys.Setting.WindowMax := (WindowState = wsMaximized) or
1591- (WindowPlacement.flags = WPF_RESTORETOMAXIMIZED);
1574+ GikoSys.Setting.WindowMax := WindowState = wsMaximized;
1575+
15921576 GikoSys.Setting.ListStyle := ListView.ViewStyle;
15931577 GikoSys.Setting.CabinetVisible := GikoDM.CabinetVisibleAction.Checked;
15941578 GikoSys.Setting.CabinetWidth := CabinetPanel.Width;
@@ -1743,7 +1727,6 @@ begin
17431727 BBSs[ i ].Free;
17441728 BBSs[ i ] := nil;
17451729 end;
1746- DestorySpecialBBS(BoardGroup.SpecialBBS);
17471730 except
17481731 end;
17491732
@@ -2584,7 +2567,20 @@ begin
25842567 end;
25852568 TreeView.Refresh;
25862569 //ListViewでこのスレが含まれる板を表示しているときの更新処理
2587- UpdateListView();
2570+ if (ActiveList <> nil) and (ActiveList is TBoard) then begin
2571+ TBoard(ActiveList).LogThreadCount := TBoard(ActiveList).GetLogThreadCount;
2572+ TBoard(ActiveList).NewThreadCount := TBoard(ActiveList).GetNewThreadCount;
2573+ TBoard(ActiveList).UserThreadCount:= TBoard(ActiveList).GetUserThreadCount;
2574+ //ListViewのアイテムの個数も更新
2575+ case GikoForm.ViewType of
2576+ gvtAll: ListView.Items.Count := TBoard(ActiveList).Count;
2577+ gvtLog: ListView.Items.Count := TBoard(ActiveList).LogThreadCount;
2578+ gvtNew: ListView.Items.Count := TBoard(ActiveList).NewThreadCount;
2579+ gvtArch: ListView.Items.Count := TBoard(ActiveList).ArchiveThreadCount;
2580+ gvtLive: ListView.Items.Count := TBoard(ActiveList).LiveThreadCount;
2581+ gvtUser: ListView.Items.Count := TBoard(ActiveList).UserThreadCount;
2582+ end;
2583+ end;
25882584 RefreshListView(Item.ThreadItem);
25892585 end;
25902586
@@ -3076,9 +3072,6 @@ begin
30763072 BBSs[i].SelectText := SelectText;
30773073 BBSs[i].KubetsuChk := KubetsuChk;
30783074 end;
3079- BoardGroup.SpecialBBS.SelectText := SelectText;
3080- BoardGroup.SpecialBBS.KubetsuChk := KubetsuChk;
3081-
30823075 ViewType := AViewType;
30833076 if ActiveList is TBoard then begin
30843077 Board := TBoard(ActiveList);
@@ -5722,7 +5715,7 @@ procedure TGikoForm.SelectComboBoxKeyDown(Sender: TObject; var Key: Word;
57225715 Shift: TShiftState);
57235716 var
57245717 IMC: HIMC;
5725- Len, idx: integer;
5718+ Len: integer;
57265719 Str: string;
57275720 tmp: string;
57285721 begin
@@ -5748,20 +5741,6 @@ begin
57485741 SetSelectWord(Str);
57495742 end;
57505743 end;
5751- end else if (Key = Windows.VK_DELETE) and (ssCtrl in Shift) then begin
5752- // Ctrl + DEL で削除する
5753- Str := SelectComboBox.Text;
5754- idx := GikoSys.Setting.SelectTextList.IndexOf( Str );
5755- if idx <> -1 then begin
5756- GikoSys.Setting.SelectTextList.Delete( idx );
5757- end;
5758- idx := SelectComboBox.Items.IndexOf( Str );
5759- if idx <> -1 then begin
5760- SelectComboBox.Items.Delete( idx );
5761- end;
5762- SelectComboBox.Text := '';
5763- // 絞込みを解除するために変更イベントを呼び出す
5764- SelectComboBox.OnChange(Sender);
57655744 end else if Length( SelectComboBox.Text ) = 0 then
57665745 begin
57675746 {* SelectComboBox.Textが空でも、入力途中でEscしたとか
@@ -6778,12 +6757,18 @@ end;
67786757 //! スレッドブラウザクリックイベント
67796758 // *************************************************************************
67806759 function TGikoForm.WebBrowserClick(Sender: TObject): WordBool;
6760+const
6761+ LIMIT = 20;
67816762 var
67826763 e: IHTMLElement;
67836764 doc : IHTMLDocument2;
67846765 FOleInPlaceActiveObject: IOleInPlaceActiveObject;
67856766 p : TPoint;
67866767 AID: string;
6768+ stlist : TStringList;
6769+ i, count: Integer;
6770+ body : String;
6771+ limited : Integer;
67876772 begin
67886773 result := true;
67896774 if not Assigned(FActiveContent) then
@@ -6795,53 +6780,63 @@ begin
67956780 FOleInPlaceActiveObject := FActiveContent.Browser.ControlInterface as IOleInPlaceActiveObject;
67966781 FOleInPlaceActiveObject.OnFrameWindowActivate(True);
67976782 GetCursorPos(p);
6798-
6783+
67996784 p.x := p.x - FActiveContent.Browser.ClientOrigin.x;
68006785 p.y := p.y - FActiveContent.Browser.ClientOrigin.y;
6801-
6786+
68026787 doc := FActiveContent.Browser.ControlInterface.Document as IHTMLDocument2;
68036788 if not Assigned(doc) then
68046789 Exit;
68056790
68066791 e := doc.elementFromPoint(p.x, p.y);
6807- if not Assigned(e) then
6792+ if not Assigned(e) then
68086793 Exit;
6809-
6794+
68106795 if (e.className = 'date') or (e.id = 'date') then begin
6811- AID := GikoSys.ExtructResID(e.innerText);
6812- ShowSameIDAncher(AID);
6796+ AID := e.innerText;
6797+ if AnsiPos('id', AnsiLowerCase(AID)) > 0 then begin
6798+ AID := Copy(AID, AnsiPos('id', AnsiLowerCase(AID)) - 1, 11);
6799+ if AnsiPos(' be:', AnsiLowerCase(AID)) > 0 then begin
6800+ AID := Copy(AID, 1, AnsiPos(' BE:', AnsiLowerCase(AID)) - 1)
6801+ end;
6802+ end else begin
6803+ stlist := TStringList.Create;
6804+ try
6805+ stList.DelimitedText := AID;
6806+ AID := '';
6807+ for i := 0 to stList.Count - 1 do begin
6808+ if Length(WideString(stList[i])) = 8 then begin
6809+ if GikoSys.NotDateorTimeString(stList[i]) then begin
6810+ AID := stList[i];
6811+ break;
6812+ end;
6813+ end;
6814+ end;
6815+ finally
6816+ stList.Free;
6817+ end;
6818+ end;
6819+
6820+ count := GikoSys.GetSameIDResCount(AID, FActiveContent.Thread);
6821+ limited := LIMIT;
6822+ if not (GikoSys.Setting.LimitResCountMessage) then begin
6823+ limited := -1;
6824+ end else if (count > LIMIT) then begin
6825+ if (GikoUtil.MsgBox(Handle,
6826+ IntToStr(LIMIT) + '個以上ありますが、すべて表示しますか?',
6827+ 'IDポップアップ警告',
6828+ MB_YESNO or MB_ICONQUESTION) = ID_YES) then begin
6829+ limited := -1;
6830+ end
6831+ end;
6832+
6833+ body := GikoSys.GetSameIDResAnchor(AID, FActiveContent.Thread, limited);
6834+ FActiveContent.IDAnchorPopup(body);
68136835 end;
68146836 except
68156837 end;
68166838 end;
6817-procedure TGikoForm.ShowSameIDAncher(const AID: String);
6818-const
6819- LIMIT = 20;
6820-var
6821- numbers : TStringList;
6822- limited : Integer;
6823-begin
6824- numbers := TStringList.Create;
6825- try
68266839
6827- GikoSys.GetSameIDRes(AID, FActiveContent.Thread, numbers);
6828- limited := LIMIT;
6829- if not (GikoSys.Setting.LimitResCountMessage) then begin
6830- limited := -1;
6831- end else if (numbers.Count > LIMIT) then begin
6832- if (GikoUtil.MsgBox(Handle,
6833- IntToStr(LIMIT) + '個以上ありますが、すべて表示しますか?',
6834- 'IDポップアップ警告',
6835- MB_YESNO or MB_ICONQUESTION) = ID_YES) then begin
6836- limited := -1;
6837- end
6838- end;
6839- FActiveContent.IDAnchorPopup(
6840- GikoSys.CreateResAnchor(numbers, FActiveContent.Thread, limited));
6841- finally
6842- numbers.Free;
6843- end;
6844-end;
68456840 //スレッド一覧を最大化してフォーカスを当てる
68466841 procedure TGikoForm.SelectTimerTimer(Sender: TObject);
68476842 begin
@@ -7758,17 +7753,10 @@ begin
77587753 end;
77597754
77607755 procedure TGikoForm.TaskTrayIconMessage(var Msg: TMsg);
7761-var
7762- p: TPoint;
77637756 begin
77647757 // 左クリックなら復元する
77657758 if (Msg.wParam = WM_LBUTTONUP) then begin
77667759 UnStoredTaskTray;
7767- end else if (Msg.wParam=WM_RBUTTONUP) then begin
7768- // 右クリックなら終了する
7769- GetCursorPos ( p );
7770- SetForegroundWindow ( Self.Handle );
7771- TaskTrayPopupMenu.Popup ( p.X, p.Y );
77727760 end;
77737761 end;
77747762 //! タスクトレイにアイコン登録&フォーム隠し
@@ -7841,6 +7829,7 @@ var
78417829 Board: TBoard;
78427830 LogFolder: String;
78437831 datList: TStringList;
7832+ p: TPoint;
78447833 begin
78457834 // 表示しているの板のとき以外は拒否
78467835 if GetActiveList is TBoard then begin
@@ -7877,12 +7866,10 @@ begin
78777866 if (datList.Count > 0) then begin
78787867 GikoSys.AddOutofIndexDat(Board, datList, False);
78797868 ShowMessage(IntToStr(datList.Count) + '個のdatファイルがコピーされました。' );
7880- if GikoForm.TreeView.Visible then begin
7869+ if GikoForm.TreeView.Visible then
78817870 GikoForm.TreeView.Refresh;
7882- end;
7883- if GikoForm.ListView.Visible then begin
7884- UpdateListView();
7885- end;
7871+ if GikoForm.ListView.Visible then
7872+ GikoForm.ListView.Refresh;
78867873 end else begin
78877874 ShowMessage('一つもコピーされませんでした。' );
78887875 end;
@@ -7895,25 +7882,7 @@ begin
78957882 ShowMessage('板を表示してください。');
78967883 end;
78977884 end;
7898-procedure TGikoForm.UpdateListView();
7899-begin
7900- //ListViewでこのスレが含まれる板を表示しているときの更新処理
7901- if (ActiveList <> nil) and (ActiveList is TBoard) then begin
7902- TBoard(ActiveList).LogThreadCount := TBoard(ActiveList).GetLogThreadCount;
7903- TBoard(ActiveList).NewThreadCount := TBoard(ActiveList).GetNewThreadCount;
7904- TBoard(ActiveList).UserThreadCount:= TBoard(ActiveList).GetUserThreadCount;
7905- //ListViewのアイテムの個数も更新
7906- case GikoForm.ViewType of
7907- gvtAll: ListView.Items.Count := TBoard(ActiveList).Count;
7908- gvtLog: ListView.Items.Count := TBoard(ActiveList).LogThreadCount;
7909- gvtNew: ListView.Items.Count := TBoard(ActiveList).NewThreadCount;
7910- gvtArch: ListView.Items.Count := TBoard(ActiveList).ArchiveThreadCount;
7911- gvtLive: ListView.Items.Count := TBoard(ActiveList).LiveThreadCount;
7912- gvtUser: ListView.Items.Count := TBoard(ActiveList).UserThreadCount;
7913- end;
7914- end;
7915- ListView.Refresh;
7916-end;
7885+
79177886 //! ファイルチェック
79187887 function TGikoForm.isValidFile(FileName: String) : boolean;
79197888 var
@@ -7930,7 +7899,7 @@ begin
79307899 end else begin
79317900 // ログファイルの拡張子をはずしたものがスレ作成日時
79327901 try
7933- dt := GikoSys.GetCreateDateFromName(ExtractFileName(FileName));
7902+ dt := GikoSys.GetCreateDateFromName(FileName);
79347903 if ((UnixToDateTime(ZERO_DATE) + OffsetFromUTC) = dt) then begin
79357904 Result := False;
79367905 GikoUtil.MsgBox(Handle, ExtractFileName(FileName) + 'のファイル名が不正です。', 'エラー', MB_ICONSTOP or MB_OK);
--- a/GikoDataModule.dfm
+++ b/GikoDataModule.dfm
@@ -1,8 +1,8 @@
11 object GikoDM: TGikoDM
22 OldCreateOrder = False
33 OnCreate = DataModuleCreate
4- Left = 518
5- Top = 174
4+ Left = 516
5+ Top = 172
66 Height = 336
77 Width = 286
88 object GikoFormActionList: TActionList
@@ -315,7 +315,7 @@ object GikoDM: TGikoDM
315315 ImageIndex = 9
316316 ShortCut = 16433
317317 OnExecute = AllItemActionExecute
318- OnUpdate = DependActiveListTBoardWithSpeciapActionUpdate
318+ OnUpdate = DependActiveListTBoardActionUpdate
319319 end
320320 object LogItemAction: TAction
321321 Category = #26495
@@ -326,7 +326,7 @@ object GikoDM: TGikoDM
326326 ImageIndex = 10
327327 ShortCut = 16434
328328 OnExecute = LogItemActionExecute
329- OnUpdate = DependActiveListTBoardWithSpeciapActionUpdate
329+ OnUpdate = DependActiveListTBoardActionUpdate
330330 end
331331 object NewItemAction: TAction
332332 Category = #26495
@@ -337,7 +337,7 @@ object GikoDM: TGikoDM
337337 ImageIndex = 11
338338 ShortCut = 16435
339339 OnExecute = NewItemActionExecute
340- OnUpdate = DependActiveListTBoardWithSpeciapActionUpdate
340+ OnUpdate = DependActiveListTBoardActionUpdate
341341 end
342342 object ArchiveItemAction: TAction
343343 Category = #26495
@@ -347,7 +347,7 @@ object GikoDM: TGikoDM
347347 Hint = 'DAT'#33853#12385#12473#12524#12483#12489#12398#12415#34920#31034#12377#12427
348348 ImageIndex = 55
349349 OnExecute = ArchiveItemActionExecute
350- OnUpdate = DependActiveListTBoardWithSpeciapActionUpdate
350+ OnUpdate = DependActiveListTBoardActionUpdate
351351 end
352352 object LiveItemAction: TAction
353353 Category = #26495
@@ -357,7 +357,7 @@ object GikoDM: TGikoDM
357357 Hint = #29983#23384#12375#12390#12356#12427#12473#12524#12483#12489#12398#12415#12434#34920#31034#12377#12427
358358 ImageIndex = 54
359359 OnExecute = LiveItemActionExecute
360- OnUpdate = DependActiveListTBoardWithSpeciapActionUpdate
360+ OnUpdate = DependActiveListTBoardActionUpdate
361361 end
362362 object ThreadRangeAction: TAction
363363 Category = #26495
@@ -367,7 +367,7 @@ object GikoDM: TGikoDM
367367 Hint = #12473#12524#12483#12489#12398#34920#31034#31684#22258#12434#35373#23450
368368 ImageIndex = 10
369369 OnExecute = ThreadRangeActionExecute
370- OnUpdate = DependActiveListTBoardWithSpeciapActionUpdate
370+ OnUpdate = DependActiveCntentActionUpdate
371371 end
372372 object SelectItemAction: TAction
373373 Category = #26495
@@ -378,7 +378,7 @@ object GikoDM: TGikoDM
378378 ImageIndex = 12
379379 ShortCut = 16436
380380 OnExecute = SelectItemActionExecute
381- OnUpdate = DependActiveListTBoardWithSpeciapActionUpdate
381+ OnUpdate = DependActiveListTBoardActionUpdate
382382 end
383383 object StopAction: TAction
384384 Category = #34920#31034
@@ -1356,27 +1356,6 @@ object GikoDM: TGikoDM
13561356 Hint = 'ID'#12434'NG'#12527#12540#12489#12501#12449#12452#12523#12395#36861#21152#12377#12427
13571357 OnExecute = AddIDtoNGWord1ActionExecute
13581358 end
1359- object ExtractSameIDAction: TAction
1360- Category = #12473#12524#12483#12489
1361- Caption = #12463#12522#12483#12503#12508#12540#12489#12398#25991#23383#21015#12434#21547#12416'ID'#12398#12524#12473#12450#12531#12459#12540#34920#31034
1362- Hint = #12463#12522#12483#12503#12508#12540#12489#12398#25991#23383#21015#12434#21547#12416'ID'#12398#12524#12473#12450#12531#12459#12540#34920#31034
1363- OnExecute = ExtractSameIDActionExecute
1364- OnUpdate = DependActiveCntentLogActionUpdate
1365- end
1366- object ShowTabListAction: TAction
1367- Category = #34920#31034
1368- Caption = #12479#12502#19968#35239#34920#31034
1369- Hint = #12479#12502#19968#35239#34920#31034
1370- OnExecute = ShowTabListActionExecute
1371- end
1372- object DereferenceResAction: TAction
1373- Tag = 1
1374- Category = #12473#12524#12483#12489
1375- Caption = #12371#12398#12524#12473#12434#21442#29031#12375#12390#12356#12427#12524#12473#12450#12531#12459#12540#34920#31034
1376- Hint = #12371#12398#12524#12473#12434#21442#29031#12375#12390#12356#12427#12524#12473#12450#12531#12459#12540#34920#31034
1377- OnExecute = DereferenceResActionExecute
1378- OnUpdate = DependActiveCntentLogActionUpdate
1379- end
13801359 end
13811360 object ToobarImageList: TImageList
13821361 Left = 44
--- a/GikoDataModule.pas
+++ b/GikoDataModule.pas
@@ -239,9 +239,6 @@ type
239239 NewLinkToClipboardAction: TAction;
240240 AddIDtoNGWord0Action: TAction;
241241 AddIDtoNGWord1Action: TAction;
242- ExtractSameIDAction: TAction;
243- ShowTabListAction: TAction;
244- DereferenceResAction: TAction;
245242 procedure EditNGActionExecute(Sender: TObject);
246243 procedure ReloadActionExecute(Sender: TObject);
247244 procedure GoFowardActionExecute(Sender: TObject);
@@ -451,9 +448,6 @@ type
451448 procedure NewLinkToClipboardActionExecute(Sender: TObject);
452449 procedure AddIDtoNGWord0ActionExecute(Sender: TObject);
453450 procedure AddIDtoNGWord1ActionExecute(Sender: TObject);
454- procedure ExtractSameIDActionExecute(Sender: TObject);
455- procedure ShowTabListActionExecute(Sender: TObject);
456- procedure DereferenceResActionExecute(Sender: TObject);
457451 private
458452 { Private 宣言 }
459453 procedure ClearResFilter;
@@ -486,10 +480,8 @@ type
486480 procedure DependActiveCntentActionUpdate(Sender: TObject);
487481 //! TActionでGetActiveContentがnil以外かつログを持っていると有効になる
488482 procedure DependActiveCntentLogActionUpdate(Sender: TObject);
489- //! TActionでActiveListがTBoard(非特殊板)で有効になる
490- procedure DependActiveListTBoardActionUpdate(Sender: TObject);
491483 //! TActionでActiveListがTBoardで有効になる
492- procedure DependActiveListTBoardWithSpeciapActionUpdate(Sender: TObject);
484+ procedure DependActiveListTBoardActionUpdate(Sender: TObject);
493485 end;
494486
495487 var
@@ -530,17 +522,9 @@ begin
530522 and (GikoForm.GetActiveContent.IsLogFile);
531523 end;
532524 // *************************************************************************
533-//! TActionでActiveListがTBoard(非特殊板)で有効になる
534-// *************************************************************************
535-procedure TGikoDM.DependActiveListTBoardActionUpdate(Sender: TObject);
536-begin
537- TAction(Sender).Enabled := (GikoForm.GetActiveList is TBoard) and
538- (GikoForm.GetActiveList <> BoardGroup.SpecialBoard);
539-end;
540-// *************************************************************************
541525 //! TActionでActiveListがTBoardで有効になる
542526 // *************************************************************************
543-procedure TGikoDM.DependActiveListTBoardWithSpeciapActionUpdate(Sender: TObject);
527+procedure TGikoDM.DependActiveListTBoardActionUpdate(Sender: TObject);
544528 begin
545529 TAction(Sender).Enabled := (GikoForm.GetActiveList is TBoard);
546530 end;
@@ -2354,6 +2338,7 @@ procedure TGikoDM.KokomadeActionExecute(Sender: TObject);
23542338 var
23552339 No: Integer;
23562340 ThreadItem: TThreadItem;
2341+ doc : IHTMLDocument2;
23572342 begin
23582343 No := GikoForm.KokoPopupMenu.Tag;
23592344 if No = 0
@@ -2419,18 +2404,28 @@ const
24192404 LIMIT = 20;
24202405 var
24212406 ThreadItem : TThreadItem;
2422- No : Integer;
2423- AID: string;
2407+ No, count: Integer;
2408+ body : string;
2409+ limited: Integer;
24242410 begin
24252411 No := GikoForm.KokoPopupMenu.Tag;
24262412 if No = 0 then Exit;
24272413 ThreadItem := GikoForm.GetActiveContent(True);
24282414 if ThreadItem = nil then Exit;
2429-
2430- AID := GikoSys.GetResID(No, ThreadItem);
2431- if not IsNoValidID(AID) then begin
2432- GikoForm.ShowSameIDAncher(AID);
2433- end;
2415+ count := GikoSys.GetSameIDResCount(No, GikoForm.ActiveContent.Thread);
2416+ limited := LIMIT;
2417+ if not (GikoSys.Setting.LimitResCountMessage) then begin
2418+ limited := -1;
2419+ end else if count > LIMIT then begin
2420+ if ( GikoUtil.MsgBox(GikoForm.Handle,
2421+ IntToStr(LIMIT) + '個以上ありますが、すべて表示しますか?',
2422+ 'IDポップアップ警告',
2423+ MB_YESNO or MB_ICONQUESTION) = ID_YES ) then begin
2424+ limited := -1;
2425+ end;
2426+ end;
2427+ body := GikoSys.GetSameIDResAnchor(No, ThreadItem, limited);
2428+ GikoForm.ActiveContent.IDAnchorPopup(body);
24342429 end;
24352430 // *************************************************************************
24362431 //! このレスあぼ〜ん (通常)
@@ -2651,8 +2646,7 @@ end;
26512646 // *************************************************************************
26522647 procedure TGikoDM.UpFolderActionUpdate(Sender: TObject);
26532648 begin
2654- UpFolderAction.Enabled := not (GikoForm.GetActiveList is TBBS) and
2655- (GikoForm.GetActiveList <> BoardGroup.SpecialBoard);
2649+ UpFolderAction.Enabled := not (GikoForm.GetActiveList is TBBS);
26562650 end;
26572651 // *************************************************************************
26582652 //! 表示 表示リストのモード変更
@@ -3015,10 +3009,9 @@ procedure TGikoDM.SelectListReloadActionUpdate(Sender: TObject);
30153009 begin
30163010 if (GikoForm.GetActiveList is TCategory) and (GikoForm.ListView.SelCount > 0) then
30173011 TAction(Sender).Enabled := True
3018- else if GikoForm.GetActiveList is TBoard then begin
3019- TAction(Sender).Enabled :=
3020- (GikoForm.GetActiveList <> BoardGroup.SpecialBoard);
3021- end else
3012+ else if GikoForm.GetActiveList is TBoard then
3013+ TAction(Sender).Enabled := True
3014+ else
30223015 TAction(Sender).Enabled := False;
30233016 end;
30243017 // *************************************************************************
@@ -3216,10 +3209,8 @@ end;
32163209 // *************************************************************************
32173210 procedure TGikoDM.LogFolderOpenActionUpdate(Sender: TObject);
32183211 begin
3219- if (((GikoForm.GetActiveList is TBoard) and
3220- (GikoForm.GetActiveList <> BoardGroup.SpecialBoard))
3221- or (GikoForm.GetActiveList is TCategory))
3222- and (GikoForm.ListView.SelCount > 0) then
3212+ if ((GikoForm.GetActiveList is TBoard) or (GikoForm.GetActiveList is TCategory))
3213+ and (GikoForm.ListView.SelCount > 0) then
32233214 TAction(Sender).Enabled := True
32243215 else
32253216 TAction(Sender).Enabled := False;
@@ -4401,7 +4392,7 @@ begin
44014392 // レスの番号を更新
44024393 if (Pos('menu:', url) > 0) then begin
44034394 index := StrToInt64Def(
4404- Copy(url, 6, Length(url)), index + 1
4395+ Copy(url, 5, Length(url)), index + 1
44054396 );
44064397 end else begin
44074398 // 開始レス番号以降かチェック
@@ -4469,99 +4460,6 @@ procedure TGikoDM.AddIDtoNGWord1ActionExecute(Sender: TObject);
44694460 begin
44704461 GikoForm.AddIDtoNGWord(false);
44714462 end;
4472-//! クリップボードの文字列をIDとして同一IDレスアンカー表示
4473-procedure TGikoDM.ExtractSameIDActionExecute(Sender: TObject);
4474-var
4475- ID: String;
4476-begin
4477- ID := Trim(Clipboard.AsText);
4478- if (Length(ID) > 0) then begin
4479- if not IsNoValidID(ID) then begin
4480- GikoForm.ShowSameIDAncher(ID);
4481- end;
4482- end;
4483-end;
4484-//! タブのスレッド一覧を表示する
4485-procedure TGikoDM.ShowTabListActionExecute(Sender: TObject);
4486-var
4487- i : Integer;
4488-begin
4489- GikoForm.ListView.Items.BeginUpdate;
4490- GikoForm.ListView.Items.Clear;
4491- BoardGroup.SpecialBoard.Clear;
4492- for i := GikoForm.BrowserTab.Tabs.Count - 1 downto 0 do begin
4493- BoardGroup.SpecialBoard.Add(
4494- TBrowserRecord(GikoForm.BrowserTab.Tabs.Objects[i]).Thread);
4495- end;
4496- GikoForm.ListView.Items.EndUpdate;
4497- GikoForm.SetActiveList(BoardGroup.SpecialBoard);
4498-end;
4499-//! 逆参照しているレスを追加する
4500-procedure TGikoDM.DereferenceResActionExecute(Sender: TObject);
4501-var
4502- i, currentNo, No : Integer;
4503- links : IHTMLElementCollection;
4504- threadItem : TThreadItem;
4505- item : IHTMLElement;
4506- url, url2 : string;
4507- resNo : TStringList;
4508- alreadyExist : Boolean;
4509- PathRec: TPathRec;
4510-begin
4511- No := GikoForm.KokoPopupMenu.Tag;
4512- if No = 0 then Exit;
4513-
4514- ThreadItem := GikoForm.GetActiveContent;
4515- // アクティブタブから全てのリンクを取得する
4516- links := GetActiveThreadLinks;
4517- if (ThreadItem <> nil) and (links <> nil) then begin
4518- resNo := TStringList.Create;
4519- try
4520- currentNo := 0;
4521- alreadyExist := False;
4522- // リンクを全て走査する
4523- for i := 0 to links.length - 1 do begin
4524- item := links.item(i, 0) as IHTMLElement;
4525- if (item <> nil) then begin
4526- url := item.getAttribute('href', 0);
4527- // レスの番号を更新
4528- if (Pos('menu:', url) > 0) then begin
4529- currentNo := StrToInt64Def(
4530- Copy(url, 6, Length(url)), currentNo + 1
4531- );
4532- alreadyExist := False;
4533- end else if (currentNo <> -1) and (not alreadyExist) then begin
4534- // IE7対応
4535- if Pos('about:..', url) = 1 then begin
4536- url := 'about:blank..' + Copy( url, Length('about:..')+1, Length(url) )
4537- end;
4538- // 自分へのリンクからレスポップ用の番号取得
4539- if Pos('about:blank..', url) = 1 then begin
4540- // No 番へのリンクがあれば参照あり
4541- url2 := THTMLCreate.GetRespopupURL(url, ThreadItem.URL);
4542- PathRec := Gikosys.Parse2chURL2(url2);
4543- if (not PathRec.FNoParam) then begin
4544- Gikosys.GetPopupResNumber(url2,PathRec.FSt,PathRec.FTo);
4545- end;
4546- // 対象レスもしくはそれを含むなら参照ありとする
4547- if (PathRec.FSt = No) or
4548- ((PathRec.FSt <= No) and (PathRec.FTo >= No)) then begin
4549- alreadyExist := True;
4550- resNo.Add(IntToStr(currentNo));
4551- end;
4552- end;
4553- end;
4554- end;
4555- end;
4556- // 無制限なので-1固定
4557- GikoForm.ActiveContent.IDAnchorPopup(
4558- GikoSys.CreateResAnchor(resNo, ThreadItem, -1));
4559- finally
4560- resNo.Clear;
4561- resNo.Free;
4562- end;
4563- end;
4564-end;
45654463
45664464 end.
45674465
--- a/GikoSystem.pas
+++ b/GikoSystem.pas
@@ -213,11 +213,13 @@ type
213213 procedure GetPopupResNumber(URL : string; var stRes, endRes : Int64);
214214
215215 property Bayesian : TGikoBayesian read FBayesian write FBayesian;
216- function CreateResAnchor(var Numbers: TStringList; ThreadItem: TThreadItem; limited: Integer):string;
216+ function GetSameIDResAnchor(const AID : string; ThreadItem: TThreadItem; limited: Integer):string; overload;
217+ function GetSameIDResAnchor(AIDNum : Integer; ThreadItem: TThreadItem; limited: Integer):string; overload;
217218 procedure GetSameIDRes(const AID : string; ThreadItem: TThreadItem;var body: TStringList); overload;
218219 procedure GetSameIDRes(AIDNum : Integer; ThreadItem: TThreadItem;var body: TStringList); overload;
220+ function GetSameIDResCount(const AID : string; ThreadItem: TThreadItem):Integer; overload;
221+ function GetSameIDResCount(AIDNum : Integer; ThreadItem: TThreadItem):Integer; overload;
219222 function GetResID(AIDNum: Integer; ThreadItem: TThreadItem): String;
220- function ExtructResID(ADateStr: String): String;
221223 //! 単語解析
222224 procedure SpamCountWord( const text : string; wordCount : TWordCount );
223225 //! 学習クリア
@@ -226,6 +228,8 @@ type
226228 procedure SpamLearn( wordCount : TWordCount; isSpam : Boolean );
227229 //! スパム度数
228230 function SpamParse( const text : string; wordCount : TWordCount ) : Extended;
231+ //引数が、日付でも時刻でもないことを調べる
232+ function NotDateorTimeString(const AStr : string): boolean;
229233
230234 //! 引数に送られてきた日付/ID部にBEの文字列があったら、プロファイルへのリンクを追加
231235 function AddBeProfileLink(AID : string; ANum: Integer): string;
@@ -2508,7 +2512,6 @@ procedure TGikoSys.ListBoardFile;
25082512 var
25092513 boardFileList : TStringList;
25102514 i, l : Integer;
2511- sCategory : TCategory;
25122515 begin
25132516 // BBS の開放
25142517 try
@@ -2551,20 +2554,6 @@ begin
25512554 BoardFileList.Free;
25522555 end;
25532556 end;
2554-
2555- // 特殊用途BBS生成
2556- // 既に存在する場合は削除する
2557- DestorySpecialBBS(BoardGroup.SpecialBBS);
2558- SpecialBBS := TBBS.Create('');
2559- SpecialBBS.Title := '特殊用途(非表示)';
2560- sCategory := TCategory.Create;
2561- sCategory.No := 1;
2562- sCategory.Title := '特殊用途(非表示)';
2563- SpecialBBS.Add(sCategory);
2564- BoardGroup.SpecialBoard := TSpecialBoard.Create(nil, 'http://localhost/gikonavi/special/index.html');
2565- BoardGroup.SpecialBoard.Title := 'タブ一覧';
2566- BoardGroup.SpecialBoard.IsThreadDatRead := True;
2567- sCategory.Add(BoardGroup.SpecialBoard);
25682557 end;
25692558
25702559 {!
@@ -2762,18 +2751,20 @@ function TGikoSys.GetSambaFileName : string;
27622751 begin
27632752 Result := Setting.GetSambaFileName;
27642753 end;
2754+
27652755 {!
2766-\brief 列挙されたレス番号へのアンカー用HTML作成
2767-\param Numbers 列挙されたレス番号
2756+\brief 同じ投稿 ID を持つレスをアンカーにして列挙
2757+\param AID 個人を特定する投稿 ID
27682758 \param ThreadItem 列挙するスレッド
27692759 \param limited 列挙する数を制限するなら1以上
27702760 \return 列挙されたレスアンカー
27712761 }
2772-function TGikoSys.CreateResAnchor(
2773- var Numbers: TStringList; ThreadItem: TThreadItem;
2762+function TGikoSys.GetSameIDResAnchor(
2763+ const AID : string; ThreadItem: TThreadItem;
27742764 limited: Integer):string;
27752765 var
27762766 i: integer;
2767+ body: TStringList;
27772768 Res: TResRec;
27782769 ResLink : TResLinkRec;
27792770 begin
@@ -2781,22 +2772,29 @@ begin
27812772 Res.FBody := '';
27822773 Res.FType := glt2chNew;
27832774
2784- Result := '';
2785- if (Numbers <> nil) and (Numbers.Count > 0) then begin
2786- if (limited > 0) and (Numbers.Count > limited) then begin
2787- for i := Numbers.Count - limited to Numbers.Count - 1 do begin
2788- Res.FBody := Res.FBody + '&gt;' + Numbers[i] + ' ';
2789- end;
2790- end else begin
2791- for i := 0 to Numbers.Count - 1 do begin
2792- Res.FBody := Res.FBody + '&gt;' + Numbers[i] + ' ';
2793- end;
2794- end;
2775+ Result := '';
2776+ if (not IsNoValidID(AID)) and
2777+ (ThreadItem <> nil) and (ThreadItem.IsLogFile) then begin
2778+ body := TStringList.Create;
2779+ try
2780+ GetSameIDRes(AID, ThreadItem, body);
2781+ if (limited > 0) and (body.Count > limited) then begin
2782+ for i := body.Count - limited to body.Count - 1 do begin
2783+ Res.FBody := Res.FBody + '&gt;' + body[i] + ' ';
2784+ end;
2785+ end else begin
2786+ for i := 0 to body.Count - 1 do begin
2787+ Res.FBody := Res.FBody + '&gt;' + body[i] + ' ';
2788+ end;
2789+ end;
2790+ finally
2791+ body.Free;
2792+ end;
27952793 ResLink.FBbs := ThreadItem.ParentBoard.BBSID;
27962794 ResLink.FKey := ChangeFileExt(ThreadItem.FileName, '');
27972795 HTMLCreater.ConvRes(@Res, @ResLink, false);
27982796 Result := Res.FBody;
2799- end;
2797+ end;
28002798 end;
28012799
28022800 {!
@@ -2811,22 +2809,6 @@ var
28112809 ReadList: TStringList;
28122810 Res: TResRec;
28132811 boardPlugIn : TBoardPlugIn;
2814-
2815- procedure CheckSameID(const AID:String; const Target: String; no: Integer);
2816- var
2817- pos: Integer;
2818- begin
2819- pos := AnsiPos('id:', LowerCase(Target));
2820- if (pos > 0) then begin
2821- if(AnsiPos(AID, Copy(Target, pos-1, Length(Target))) > 0) then begin
2822- body.Add(IntToStr(no));
2823- end;
2824- end else begin
2825- if(AnsiPos(AID, Target) > 0) then begin
2826- body.Add(IntToStr(no));
2827- end;
2828- end;
2829- end;
28302812 begin
28312813 if (not IsNoValidID(AID)) and
28322814 (ThreadItem <> nil) and (ThreadItem.IsLogFile) then begin
@@ -2839,7 +2821,9 @@ begin
28392821 for i := 0 to threadItem.Count - 1 do begin
28402822 // レス
28412823 THTMLCreate.DivideStrLine(boardPlugIn.GetDat(DWORD( threadItem ), i + 1), @Res);
2842- CheckSameID(AID, Res.FDateTime, i+1);
2824+ if(AnsiPos(AID, Res.FDateTime) > 0) then begin
2825+ body.Add(IntToStr(i+1));
2826+ end;
28432827 end;
28442828 end else begin
28452829 ReadList := TStringList.Create;
@@ -2847,7 +2831,9 @@ begin
28472831 ReadList.LoadFromFile(ThreadItem.GetThreadFileName);
28482832 for i := 0 to ReadList.Count - 1 do begin
28492833 THTMLCreate.DivideStrLine(ReadList[i], @Res);
2850- CheckSameID(AID, Res.FDateTime, i+1);
2834+ if AnsiPos(AID, Res.FDateTime) > 0 then begin
2835+ body.Add(IntToStr(i+1));
2836+ end;
28512837 end;
28522838 finally
28532839 ReadList.Free;
@@ -2860,6 +2846,50 @@ end;
28602846 \brief 同じ投稿 ID を持つレスを列挙
28612847 \param AIDNum 個人を特定する投稿 ID
28622848 \param ThreadItem 列挙するスレッド
2849+\param limited 列挙する数を制限するなら1以上
2850+\return
2851+}
2852+function TGikoSys.GetSameIDResAnchor(AIDNum : Integer;
2853+ ThreadItem: TThreadItem;
2854+ limited: Integer):string;
2855+var
2856+ i: integer;
2857+ body: TStringList;
2858+ Res: TResRec;
2859+ ResLink : TResLinkRec;
2860+begin
2861+ // body以外は使用しないので初期化しない
2862+ Res.FBody := '';
2863+ Res.FType := glt2chNew;
2864+
2865+ Result := '';
2866+ if (ThreadItem <> nil) and (ThreadItem.IsLogFile) then begin
2867+ body := TStringList.Create;
2868+ try
2869+ GetSameIDRes(AIDNum, ThreadItem, body);
2870+ if (limited > 0) and ( body.Count > limited) then begin
2871+ for i := body.Count - 20 to body.Count - 1 do begin
2872+ Res.FBody := Res.FBody + '&gt;' + body[i] + ' ';
2873+ end;
2874+ end else begin
2875+ for i := 0 to body.Count - 1 do begin
2876+ Res.FBody := Res.FBody + '&gt;' + body[i] + ' ';
2877+ end;
2878+ end;
2879+ finally
2880+ body.Free;
2881+ end;
2882+ ResLink.FBbs := ThreadItem.ParentBoard.BBSID;
2883+ ResLink.FKey := ChangeFileExt(ThreadItem.FileName, '');
2884+ HTMLCreater.ConvRes(@Res, @ResLink, false);
2885+ Result := Res.FBody;
2886+ end;
2887+end;
2888+
2889+{!
2890+\brief 同じ投稿 ID を持つレスを列挙
2891+\param AIDNum 個人を特定する投稿 ID
2892+\param ThreadItem 列挙するスレッド
28632893 \param body OUT:列挙されたレス番号が返る
28642894 }
28652895 procedure TGikoSys.GetSameIDRes(AIDNum : Integer; ThreadItem: TThreadItem;var body: TStringList);
@@ -2881,6 +2911,8 @@ function TGikoSys.GetResID(AIDNum: Integer; ThreadItem: TThreadItem): String;
28812911 var
28822912 Res: TResRec;
28832913 boardPlugIn : TBoardPlugIn;
2914+ stList: TStringList;
2915+ i : Integer;
28842916 begin
28852917 Result := '';
28862918 if (ThreadItem <> nil) and (ThreadItem.IsLogFile)
@@ -2894,40 +2926,96 @@ begin
28942926 end else begin
28952927 THTMLCreate.DivideStrLine( ReadThreadFile(ThreadItem.GetThreadFileName, AIDNum), @Res);
28962928 end;
2897- Result := ExtructResID(Res.FDateTime);
2929+ Result := Res.FDateTime;
2930+ if AnsiPos('id', AnsiLowerCase(Result)) > 0 then begin
2931+ Result := Copy(Result, AnsiPos('id', AnsiLowerCase(Result)) - 1, 11);
2932+ if AnsiPos(' be:', AnsiLowerCase(Result)) > 0 then begin
2933+ Result := Copy(Result, 1, AnsiPos(' BE:', AnsiLowerCase(Result)) - 1)
2934+ end;
2935+ end else begin
2936+ stlist := TStringList.Create;
2937+ try
2938+ stList.DelimitedText := Result;
2939+ Result := '';
2940+ for i := 0 to stList.Count - 1 do
2941+ if Length(WideString(stList[i])) = 8 then begin
2942+ if NotDateorTimeString(stList[i]) then begin
2943+ Result := stList[i];
2944+ break;
2945+ end;
2946+ end;
2947+ finally
2948+ stList.Free;
2949+ end;
2950+ end;
28982951 end;
28992952 end;
29002953 {!
2901-\brief レスの時刻部からIDを抽出する
2902-\param ADateStr 時刻部の文字列
2903-\return ID(IDとみなせる部分がないときは空文字列)
2954+\brief 同じ投稿 ID を持つレスをカウント
2955+\param AID 個人を特定する投稿 ID
2956+\param ThreadItem 列挙するスレッド
2957+\return 同じ ID を持つレスの数
29042958 }
2905-function TGikoSys.ExtructResID(ADateStr: String): String;
2959+function TGikoSys.GetSameIDResCount(const AID : string; ThreadItem: TThreadItem):Integer;
29062960 var
2907- stlist : TStringList;
2961+ body: TStringList;
29082962 begin
2909- Result := '';
2910- if AnsiPos('id', AnsiLowerCase(ADateStr)) > 0 then begin
2911- Result := Copy(ADateStr, AnsiPos('id', AnsiLowerCase(ADateStr)), Length(ADateStr));
2912- if AnsiPos(' ', Result) > 0 then begin
2913- Result := Copy(Result, 1, AnsiPos(' ', Result) - 1);
2914- end;
2915- Result := ' ' + Result;
2916- end else begin
2917- stlist := TStringList.Create;
2918- try
2919- stList.Delimiter := ' ';
2920- stList.DelimitedText := ADateStr;
2921- // 日付 時刻 ID 他 と固定で考える
2922- if (stList.Count >= 3) then begin
2923- if Length(stList[3 - 1]) >= 7 then begin
2924- Result := stList[3 - 1];
2925- end;
2926- end;
2927- finally
2928- stList.Free;
2929- end;
2930- end;
2963+ Result := 0;
2964+ if (not IsNoValidID(AID))
2965+ and (ThreadItem <> nil) and (ThreadItem.IsLogFile) then begin
2966+ body := TStringList.Create;
2967+ try
2968+ GetSameIDRes(AID, ThreadItem, body);
2969+ Result := body.Count;
2970+ finally
2971+ body.Free;
2972+ end;
2973+ end;
2974+
2975+end;
2976+
2977+{!
2978+\brief 同じ投稿 ID を持つレスをカウント
2979+\param AIDNum 個人を特定する投稿 ID
2980+\param ThreadItem 列挙するスレッド
2981+\return 同じ ID を持つレスの数
2982+}
2983+function TGikoSys.GetSameIDResCount(AIDNum : Integer; ThreadItem: TThreadItem):Integer;
2984+var
2985+ body: TStringList;
2986+begin
2987+ Result := 0;
2988+ if (ThreadItem <> nil) and (ThreadItem.IsLogFile) then begin
2989+ body := TStringList.Create;
2990+ try
2991+ GetSameIDRes(AIDNum, ThreadItem, body);
2992+ Result := body.Count;
2993+ finally
2994+ body.Free;
2995+ end;
2996+ end;
2997+end;
2998+
2999+{!
3000+\brief 時刻を示す文字列では無いかどうか
3001+\param AStr 調べる文字列
3002+\return 時刻では無いなら True
3003+\todo 否定形(Not)より肯定系(Is)
3004+}
3005+function TGikoSys.NotDateorTimeString(const AStr : string): boolean;
3006+begin
3007+ Result := false;
3008+ try
3009+ StrToDate(AStr);
3010+ except
3011+ try
3012+ StrToTime(AStr);
3013+ Result := false;
3014+ except
3015+ Result := true;
3016+ end;
3017+ end;
3018+
29313019 end;
29323020
29333021 {!
@@ -3397,10 +3485,8 @@ begin
33973485 end;
33983486
33993487 procedure TGikoSys.ShowRefCount(msg: String; unk: IUnknown);
3400-{$IFDEF DEBUG}
34013488 var
34023489 count : integer;
3403-{$ENDIF}
34043490 begin
34053491 if not Assigned(unk) then
34063492 Exit;
--- a/Option.pas
+++ b/Option.pas
@@ -1325,19 +1325,13 @@ begin
13251325 end;
13261326
13271327 procedure TOptionDialog.SoundPlayButtonClick(Sender: TObject);
1328-var
1329- s : String;
13301328 begin
1331- s := SoundFileEdit.Text;
1332- if (AnsiPos('.\', s) = 1) then begin
1333- s := GikoSys.Setting.GetAppDir + Copy(s, 2, Length(s));
1334- end;
1335- if not FileExists(s) then begin
1329+ if not FileExists(SoundFileEdit.Text) then begin
13361330 MsgBox(Handle, '存在しないファイルです', 'エラー', MB_ICONSTOP or MB_OK);
13371331 SoundFileEdit.Text := '';
13381332 Exit;
13391333 end;
1340- if not sndPlaySound(PChar(s), SND_ASYNC or SND_NOSTOP) then begin
1334+ if not sndPlaySound(PChar(SoundFileEdit.Text), SND_ASYNC or SND_NOSTOP) then begin
13411335 sndPlaySound(nil, SND_ASYNC);
13421336 end;
13431337 end;
--- a/ResPopupBrowser.pas
+++ b/ResPopupBrowser.pas
@@ -66,8 +66,6 @@ begin
6666 RawDocument := '';
6767 FEvent := nil;
6868 ShowWindow(Self.Handle, SW_HIDE);
69- GikoSys.ShowRefCount('ResPop Create', Self.ControlInterface);
70- GikoSys.ShowRefCount('ResPop.Document Create', Self.ControlInterface.Document);
7169 end;
7270
7371 destructor TResPopupBrowser.Destroy;
@@ -86,10 +84,6 @@ begin
8684 FEvent := nil;
8785 end;
8886 FThread := nil;
89-
90- GikoSys.ShowRefCount('ResPop Desctroy', Self.ControlInterface);
91- GikoSys.ShowRefCount('ResPop.Document Create', Self.ControlInterface.Document);
92-
9387 inherited Destroy;
9488 end;
9589
@@ -142,7 +136,7 @@ begin
142136 end;
143137 procedure TResPopupBrowser.NavigateBlank(Forced: Boolean);
144138 begin
145- if (not Assigned(Self.ControlInterface.Document)) or (Forced) then begin
139+ if (not Assigned(Self.Document)) or (Forced) then begin
146140 Self.Navigate('about:blank');
147141 end;
148142 while (Self.ReadyState <> READYSTATE_COMPLETE) and
@@ -198,7 +192,7 @@ begin
198192 ARect := CalcRect(Screen.MonitorFromPoint(p).WorkareaRect,
199193 not OnlyTitle);
200194
201- FEvent := THTMLDocumentEventSink.Create(Self, Self.OleObject.Document, HTMLDocumentEvents2);
195+ FEvent := THTMLDocumentEventSink.Create(Self, Self.Document, HTMLDocumentEvents2);
202196 FEvent.OnClick := ResPopupBrowserClick;
203197 FEvent.OnDoubleClick := ResPopupBrowserDbClick;
204198 Self.Visible := True;
@@ -278,7 +272,7 @@ var
278272 DIV_X, DIV_Y: Integer;
279273 begin
280274 GetCursorpos(p);
281- ele := ((Self.ControlInterface.Document as IHTMLDocument2).body as IHTMLElement2);
275+ ele := ((Self.Document as IHTMLDocument2).body as IHTMLElement2);
282276 if Scroll then begin
283277 h := GetWindowHeight + 10;
284278 w := ele.scrollWidth + 25
--- a/Setting.pas
+++ b/Setting.pas
@@ -1218,16 +1218,8 @@ begin
12181218 if Exists then begin
12191219 for i := 0 to GetSoundCount - 1 do begin
12201220 SoundFileName[i] := ini.ReadString('Sound', SoundName[i], '');
1221- // 相対参照対策
1222- s := SoundFileName[i];
1223- if (AnsiPos('.\', SoundFileName[i]) = 1) then begin
1224- s := GetAppDir
1225- + Copy(SoundFileName[i], 2, Length(SoundFileName[i]));
1226- end;
1227- // ファイルの存在チェック
1228- if not FileExists(SoundFileName[i]) then begin
1229- SoundFileName[i] := '';
1230- end;
1221+ if not FileExists(SoundFileName[i]) then
1222+ SoundFileName[i] := '';
12311223 end;
12321224 end else begin
12331225 s := GetAppDir + '\sound\';
@@ -1880,11 +1872,6 @@ begin
18801872 for i := 0 to GetSoundCount - 1 do begin
18811873 if SoundName[i] = Name then begin
18821874 Result := SoundFileName[i];
1883- // 相対パス対策
1884- if (AnsiPos('.\', Result) = 1) then begin
1885- Result := GetAppDir
1886- + Copy(Result, 2, Length(Result));
1887- end;
18881875 Exit;
18891876 end;
18901877 end;
Binary files a/gikoNavi.res and b/gikoNavi.res differ
--- a/readme/readme.txt
+++ b/readme/readme.txt
@@ -79,7 +79,7 @@ http://www.microsoft.com/windows95/downloads/contents/WUAdminTools/S_WUNetworkin
7979 ------------------------------
8080 開発ツール:Delphi6 Professional (UP2 + RTL UP2 + RTL UP3)
8181 Delphi6 Personal(UP2 + RTL UP2 + RTL UP3)
82-OS :WindowsXP Professional Edition(SP3) + IE7
82+OS :WindowsXP Professional Edition(SP2) + IE7
8383 WindowsXP Professional Edition(SP1) + IE6(SP1)
8484 Windows2000 Professional (SP4) + IE6(SP1)
8585
@@ -108,16 +108,10 @@ LICENSE
108108 ------------------------------
109109 履歴
110110 ------------------------------
111-2008/09/20
111+2008/0X/XX
112112 Version バタ58
113113 プレビューのURLから登録してある外部アプリを起動する機能を追加
114114 レス送信エディタで、連続して投稿できるようにする機能を追加
115- 開いているタブのスレッドの一覧をスレッド一覧に表示する機能を追加
116- まちBBSのPATH_INFO形式のURLに対応
117- サウンドイベントのファイル指定を相対パスで指定できるように修正
118- 表示中のタブの一覧をスレッド一覧に表示するアクションを追加
119- したらばJBBSの板更新機能修正
120- datファイルをスレッド一覧にD&Dしたときに、ファイル名が不正ですエラーに常になる不具合の修正
121115
122116 2008/03/22
123117 Version バタ57 リリース2
--- a/res/ExternalBoardPlugIn/MachiBBSPlugIn.dpr
+++ b/res/ExternalBoardPlugIn/MachiBBSPlugIn.dpr
@@ -83,7 +83,7 @@ const
8383 MAJOR_VERSION = 1;
8484 MINOR_VERSION = 0;
8585 RELEASE_VERSION = 'beta';
86- REVISION_VERSION = 19;
86+ REVISION_VERSION = 18;
8787
8888 // =========================================================================
8989 // 雑用関数
@@ -269,7 +269,6 @@ var
269269 const
270270 BBS_HOST = 'machi.to';
271271 THREAD_MARK = '/bbs/read.pl';
272- THREAD_MARK2= '/bbs/read.cgi';
273272 begin
274273
275274 try
@@ -281,10 +280,6 @@ begin
281280 foundPos := AnsiPos( BBS_HOST, uri.Host );
282281 if (foundPos > 0) and (Length( uri.Host ) - foundPos + 1 = Length( BBS_HOST )) then begin
283282 foundPos := Pos( THREAD_MARK, inURL );
284- if (foundPos = 0) then begin
285- // 新URL対応
286- foundPos := Pos( THREAD_MARK2, inURL );
287- end;
288283 if foundPos > 0 then
289284 Result := atThread
290285 else if (uriList.Count > 1) and (uri.Path <> '/') then // 最後が '/' で閉められてるなら 3
@@ -314,10 +309,9 @@ procedure OnExtractBoardURL(
314309 var
315310 uri : TIdURI;
316311 uriList : TStringList;
317- URL : String;
312+ URL : String;
318313 const
319314 THREAD_MARK = '/bbs/read.pl';
320- THREAD_MARK2= '/bbs/read.cgi';
321315 begin
322316 URL := string(inURL);
323317 if AnsiPos(THREAD_MARK, URL) > 0 then begin
@@ -339,27 +333,6 @@ begin
339333 uri.Free;
340334 uriList.Free;
341335 end;
342- end else if AnsiPos(THREAD_MARK2, URL) > 0 then begin
343- if Copy( inURL, Length( inURL ), 1 ) = '/' then
344- uri := TIdURI.Create( URL )
345- else
346- uri := TIdURI.Create( URL + '/' );
347-
348- uriList := TStringList.Create;
349- try
350- // http://kanto.machi.to/bbs/read.cgi/kana/1215253035/l50
351- // http://kanto.machi.to/kana/
352- uriList.Delimiter := '/';
353- uriList.DelimitedText := uri.Path;
354- URL := uri.Protocol + '://' + uri.Host + '/';
355- if (uriList.Count >= 4) then begin
356- URL := URL + uriList[3] + '/';
357- end;
358- outURL := CreateResultString(URL);
359- finally
360- uri.Free;
361- uriList.Free;
362- end;
363336 end else begin
364337 outURL := CreateResultString(URL);
365338 end;
@@ -900,8 +873,6 @@ var
900873 uri : TIdURI;
901874 uriList : TStringList;
902875 foundPos : Integer;
903-const
904- THREAD_MARK2= '/bbs/read.cgi';
905876 begin
906877
907878 foundPos := AnsiPos( '?', URL );
@@ -917,26 +888,7 @@ begin
917888 uri.Free;
918889 uriList.Free;
919890 end;
920- end else begin
921- // 新形式 ?
922- foundPos := AnsiPos(THREAD_MARK2, URL);
923- if (foundPos > 0) then begin
924- uri := TIdURI.Create( URL );
925- uriList := TStringList.Create;
926- try
927- uriList.Delimiter := '/';
928- uriList.DelimitedText := uri.Path;
929- if (uriList.Count >= 5) then begin
930- Result :=
931- uri.Protocol + '://' + uri.Host + '/bbs/read.pl?' +
932- 'BBS=' + uriList[3] + '&KEY=' + uriList[4];
933- end;
934- finally
935- uri.Free;
936- uriList.Free;
937- end;
938- end;
939- end;
891+ end;
940892
941893 end;
942894
Binary files a/res/ExternalBoardPlugIn/MachiBBSPlugIn.res and b/res/ExternalBoardPlugIn/MachiBBSPlugIn.res differ
--- a/res/ExternalBoardPlugIn/ShitarabaJBBSAcquireBoard.pas
+++ b/res/ExternalBoardPlugIn/ShitarabaJBBSAcquireBoard.pas
@@ -201,9 +201,6 @@ var
201201 key : string;
202202 htmlList : TStringList;
203203 i : Integer;
204-
205- resultArea : Boolean;
206- pos : Integer;
207204 const
208205 //http://rentalbbs.livedoor.com/jbbs/search/?word=%C2%E7%B3%D8&category=auto
209206 BBS_HOST = 'http://rentalbbs.livedoor.com/';
@@ -215,7 +212,7 @@ const
215212 label
216213 NextBoard;
217214 begin
218- responseCode := 0;
215+
219216 category := CATEGORIES[ CategoryComboBox.ItemIndex ];
220217 boardname := BoardNameEdit.Text;
221218
@@ -240,30 +237,31 @@ begin
240237 htmlList := TStringList.Create();
241238 try
242239 htmlList.Text := CustomStringReplace(downResult, '<br>', #13#10);
243- resultArea := False;
244- for i := 0 to htmlList.Count - 1 do begin
240+ for i := htmlList.Count - 1 downto 0 do begin
245241 downResult := htmlList[i];
246242 try
247- //<div class="searchResults">
248- //<h2><span class="ranking">[1]</span><a href="http://jbbs.livedoor.jp/auto/5497/">MIT-MCC BBS</a><span class="point"><span class="all">4750pt</span><span class="yesterday">(Yesterday40 pt)</span></span></h2>
249- //<p>武蔵工業大学 モータサイクル部のBBSです。各自チェックするようにしましょう♪(&amp;gt;_&amp;lt;)b</p>
250- //</div>
251- if (not resultArea) and (AnsiPos('class="searchResults"', downResult) > 0) then begin
252- resultArea := True;
253- end else if (resultArea) then begin
254- pos := AnsiPos('<a href="', downResult);
255- if (pos > 0) then begin
256- resultArea := False;
257- downResult := Copy(downResult, pos + 9, Length(downResult));
258- key := Copy(downResult, 1, AnsiPos('"', downResult)-1);
259- downResult := Copy(downResult, AnsiPos('>', downResult) + 1, Length(downResult));
260-
261- board := Copy(downResult, 1, AnsiPos('</a>', downResult) -1);
262-
263- board := CustomStringReplace(board, '=', '=') + '=' + key;
264- LogEdit.SelText := board + #13#10;
265- FBoardList.Add( board );
266- end;
243+ //<a href="/auto/2348/">トヨタ自動車掲示板</a>
244+ //<small><strng><a href="http://jbbs.livedoor.jp/auto/4112/">明治大学 二部・短大</a></strong></small></td>
245+ if (AnsiPos('<small><strng><a href="', downResult) > 0)
246+ and (AnsiPos(category, downResult) > 0) then begin
247+ downResult := CustomStringReplace(downResult, '<small><strng>', '');
248+ board := Copy(downResult, AnsiPos('<a href="', downResult) + 9,
249+ Length(downResult));
250+ key := Copy(board, AnsiPos('">', board) + 2,
251+ Length(board));
252+ key := Copy(key, 1, AnsiPos('</a>', key) -1);
253+
254+ board := Copy(board, 1, AnsiPos('">', board) - 1);
255+ if (board = '../') then begin
256+ board := CustomStringReplace(board, '../', BOARD_HOST);
257+ end else if (AnsiPos('/', board) = 1) then begin
258+ board := BOARD_HOST + Copy(board, 2, Length(board));
259+ end;
260+
261+ board := key + '=' + board;
262+
263+ LogEdit.SelText := board + #13#10;
264+ FBoardList.Add( board );
267265 end;
268266 except
269267 end;
--- a/res/ExternalBoardPlugIn/ShitarabaJBBSPlugIn.dpr
+++ b/res/ExternalBoardPlugIn/ShitarabaJBBSPlugIn.dpr
@@ -2,7 +2,7 @@ library ShitarabaJBBSPlugIn;
22
33 {
44 ShitarabaJBBSPlugIn
5- $Id: ShitarabaJBBSPlugIn.dpr,v 1.45 2008/08/03 02:45:48 h677 Exp $
5+ $Id: ShitarabaJBBSPlugIn.dpr,v 1.44 2006/07/02 09:48:04 h677 Exp $
66 }
77
88 uses
@@ -83,7 +83,7 @@ const
8383 MAJOR_VERSION = 1;
8484 MINOR_VERSION = 1;
8585 RELEASE_VERSION = 'alpha';
86- REVISION_VERSION = 17;
86+ REVISION_VERSION = 15;
8787
8888 SYNCRONIZE_MENU_CAPTION = 'したらばJBBS板更新';
8989
Binary files a/res/ExternalBoardPlugIn/ShitarabaJBBSPlugIn.res and b/res/ExternalBoardPlugIn/ShitarabaJBBSPlugIn.res differ
--- a/res/default/Samba.default
+++ b/res/default/Samba.default
@@ -1,31 +1,40 @@
11 [Setting]
2-@endless=20
32 @liveplus=10
4-@news=156
3+@news=30
54 @newsplus=128
6-@operate=24
7-@sec2chd=20
8-academy6=45
9-babiru=30
10-bubble6=45
11-changi=45
12-ex24=45
13-food8=45
14-gimpo=45
15-ipv6=45
16-life9=45
17-live23=15
18-live24=15
19-love6=45
20-mamono=45
21-namidame=45
22-pc11=45
23-qb5=45
24-qiufen=30
25-schiphol=45
26-science6=45
27-set=30
28-society6=45
29-venus=30
30-yomi=30
31-yutori=10
5+@news4vip=10
6+@news4viptasu=10
7+academy6=20
8+anime3=20
9+bubble6=20
10+etc7=20
11+ex21=20
12+food8=20
13+game13=20
14+game14=20
15+hobby10=20
16+human7=20
17+life9=20
18+live23=10
19+live24=10
20+live27=10
21+love6=20
22+mamono=10
23+money6=20
24+music8=20
25+namidame=10
26+news24=20
27+pc11=20
28+qb5=20
29+qiufen=20
30+babiru=20
31+yomi=20
32+venus=20
33+set=20
34+school7=20
35+science6=20
36+society6=20
37+sports11=20
38+tmp7=20
39+tv11=20
40+yutori=20
\ No newline at end of file
Show on old repository browser