Develop and Download Open Source Software

Browse CVS Repository

Diff of /gikonavigoeson/gikonavi/BoardGroup.pas

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph | View Patch Patch

revision 1.50.2.1 by h677, Sat Jan 1 12:14:10 2005 UTC revision 1.77 by h677, Sat Jan 31 15:48:36 2009 UTC
# Line 3  unit BoardGroup; Line 3  unit BoardGroup;
3  interface  interface
4    
5  uses  uses
6          Windows, SysUtils, Classes, ComCtrls, IniFiles, {HTTPApp,} YofUtils, IdGlobal,          Windows, SysUtils, Classes, ComCtrls, {HTTPApp,} YofUtils, IdGlobal,
7          ExternalBoardManager, ExternalBoardPlugInMain, StrUtils, DateUtils;          ExternalBoardManager, ExternalBoardPlugInMain, StrUtils;
8    
9  type  type
10          //リストの表示アイテム選択          //リストの表示アイテム選択
11          TGikoViewType = (gvtAll, gvtLog, gvtNew, gvtUser);          TGikoViewType = (gvtAll, gvtLog, gvtNew, gvtLive, gvtArch, gvtUser);
         //リストの取得件数  
         //TGikoListCount = (glc50, glc100, glc200, glc500, glc1000, glcAll);  
         //巡回番号  
         //TGikoRoundNo = (grnNone, grn1, grn2, grn3, grn4, grn5, grnOnce);  
12          //リストの上げ下げ          //リストの上げ下げ
13          TGikoAgeSage = (gasNone, gasAge, gasSage, gasNew, gasNull);          TGikoAgeSage = (gasNone, gasAge, gasSage, gasNew, gasArch, gasNull);
   
 {       TFolder = class  
         private  
                 FItemList: TList;       //子アイテムリスト  
                 FLeaf: Boolean;         //下にフォルダを持つことが出来るか  
         public  
                 function Add(Item: TFolder): Integer;  
                 procedure Clear;  
                 procedure Delete(Index: Integer);  
                 procedure Exchange(Index1, Index2: Integer);  
                 procedure Insert(Index: Integer; Item: TFolder);  
                 procedure Move(CurIndex, NewIndex: Integer);  
                 function Remove(Item: TFolder): Integer;  
                 procedure Sort(Compare: TListSortCompare);  
                 property Capacity: Integer read FCapacity write SetCapacity;  
                 property Count: Integer read FCount write SetCount;  
                 property Items[Index: Integer]: TFolder read Get write Put; default;  
   
                 property Leaf: Boolean read FLeaf;  
         end;  
   
         TBBS = class(TFolder)  
         end;  
         TCategory class(TFolder)  
         end;  
         TBoard = class(TFolder)  
         end;  
         TThreadItem = class(TFolder)  
         end;  
 }  
   
 {  
         TBBS = class(TBBS)  
         end;  
         TBoard2ch = class(TBoard)  
         end;  
         TThreadItem2ch = class(TThreadItem)  
         end;  
 }  
   
 //      ITest = interface  
 //      end;  
 //      IBBS = interface  
 //      end;  
 //      ICategory = interface  
 //      end;  
 //      IBoard = interface  
 //      end;  
 //      IThreadItem = interface  
 //      end;  
14    
15          TCategory = class;          TCategory = class;
16          TBoard = class;          TBoard = class;
17          TThreadItem = class;          TThreadItem = class;
18    
19    
20          // BBS のルート          // BBS のルート
21          TBBS = class(TList)          TBBS = class(TList)
22          private          private
# Line 112  type Line 59  type
59          end;          end;
60    
61          // カテゴリ(板 URL のリスト)          // カテゴリ(板 URL のリスト)
62          TCategory = class(THashedStringList)          TCategory = class(TStringList)
63          private          private
64                  FNo: Integer;                  FNo: Integer;
65                  FTitle: string;                  FTitle: string;
# Line 143  type Line 90  type
90                  property NodeExpand: Boolean read FExpand write FExpand;                  property NodeExpand: Boolean read FExpand write FExpand;
91          end;          end;
92    
93            //! スレッド数カウント条件文
94            TThreadCount = function(Item : TThreadItem): Boolean;
95    
96          // 板(スレッド URL のリスト)          // 板(スレッド URL のリスト)
97          TBoard = class(THashedStringList)          TBoard = class(TStringList)
98          private          private
99                  FContext: DWORD;                                                        // プラグインが自由に設定していい値(主にインスタンスが入る)                  FContext: DWORD;                                                        // プラグインが自由に設定していい値(主にインスタンスが入る)
100    
# Line 164  type Line 114  type
114                  FBoolData: Boolean;                                             //いろんな用途に使うyo                  FBoolData: Boolean;                                             //いろんな用途に使うyo
115                  FSPID: string;                                                          //書き込み用SPID                  FSPID: string;                                                          //書き込み用SPID
116                  FPON: string;                                                                   //書き込み用PON                  FPON: string;                                                                   //書き込み用PON
117                    FCookie: string;                                                //書き込み用Cookie文字列
118                    FExpires: TDateTime;                                    //Cookieの有効期限
119                  FKotehanName: string;                                   //コテハン名前                  FKotehanName: string;                                   //コテハン名前
120                  FKotehanMail: string;                                   //コテハンメール                  FKotehanMail: string;                                   //コテハンメール
121    
# Line 176  type Line 128  type
128                  FIntData                        : Integer;                      // 好きにいじってよし。いろんな用途に使うyo                  FIntData                        : Integer;                      // 好きにいじってよし。いろんな用途に使うyo
129                  FListData                       : TList;                                // 好きにいじってよし。いろんな用途に使うyo                  FListData                       : TList;                                // 好きにいじってよし。いろんな用途に使うyo
130    
131                  FSETTINGTXTTime: TDateTime;     //SETTING.TXTを取得した日時                  FSETTINGTXTTime : TDateTime;    //SETTING.TXTを取得した日時
132                  FIsSETTINGTXT:          boolean;        //SETTING.TXTを取得しているか                  FIsSETTINGTXT   : boolean;      //SETTING.TXTを取得しているか
133                  FHEADTXTTime: TDateTime;                //HEAD.TXTを取得した日時                  FHEADTXTTime    : TDateTime;            //HEAD.TXTを取得した日時
134                  FIsHEADTXT:             boolean;        //HEAD.TXTを取得しているか                  FIsHEADTXT              : boolean;      //HEAD.TXTを取得しているか
135          FTitlePictureURL:       string; //top絵のURL                  FTitlePictureURL: string;       //top絵のURL
136                    FMultiplicity   : Integer; //重複しているかどうか?
137                    FIs2ch                  : Boolean; //hostが2chかどうか
138                    FNewThreadCount: Integer;       //新着スレッドの数
139                    FLogThreadCount: Integer;       //ログ有りスレッドの数
140                    FUserThreadCount: Integer;      //?
141                    FLiveThreadCount: Integer;      //生存スレッド数
142                    FArchiveThreadCount: Integer;   //DAT落ちスレッド数
143                  function GetThreadItem(index: integer): TThreadItem;                  function GetThreadItem(index: integer): TThreadItem;
144                  procedure SetThreadItem(index: integer; value: TThreadItem);                  procedure SetThreadItem(index: integer; value: TThreadItem);
145                  procedure SetRound(b: Boolean);                  procedure SetRound(b: Boolean);
146                  procedure SetRoundName(s: string);                  procedure SetRoundName(s: string);
147                    //procedure SetRoundName(s: PChar);
148                  procedure SetLastModified(d: TDateTime);                  procedure SetLastModified(d: TDateTime);
149                  procedure SetLastGetTime(d: TDateTime);                  procedure SetLastGetTime(d: TDateTime);
150                  procedure SetUnRead(i: Integer);                  procedure SetUnRead(i: Integer);
# Line 204  type Line 163  type
163                  property BBSID: string read FBBSID write FBBSID;                  property BBSID: string read FBBSID write FBBSID;
164                  property URL: string read FURL write FURL;                  property URL: string read FURL write FURL;
165                  property Round: Boolean read FRound write SetRound;                  property Round: Boolean read FRound write SetRound;
166                    //property RoundName: PChar read FRoundName write SetRoundName;
167                  property RoundName: string read FRoundName write SetRoundName;                  property RoundName: string read FRoundName write SetRoundName;
168                  property RoundDate: TDateTime read FRoundDate write FRoundDate;                  property RoundDate: TDateTime read FRoundDate write FRoundDate;
169                  property LastModified: TDateTime read FLastModified write SetLastModified;                  property LastModified: TDateTime read FLastModified write SetLastModified;
# Line 228  type Line 188  type
188                  function FindThreadFromFileName(const ItemFileName: string): TThreadItem;                  function FindThreadFromFileName(const ItemFileName: string): TThreadItem;
189                  function FindThreadFromURL(const inURL : string ) : TThreadItem;                  function FindThreadFromURL(const inURL : string ) : TThreadItem;
190                  function GetIndexFromFileName(const ItemFileName: string): Integer;                  function GetIndexFromFileName(const ItemFileName: string): Integer;
191                  function GetIndexFromURL(const URL: string): Integer;                  function GetIndexFromURL(const URL: string; reverse : Boolean = False): Integer;
192                  procedure LoadSettings;                  procedure LoadSettings;
193                  procedure SaveSettings;                  procedure SaveSettings;
194                  function GetReadCgiURL: string;                  function GetReadCgiURL: string;
# Line 241  type Line 201  type
201    
202                  function GetNewThreadCount: Integer;                  function GetNewThreadCount: Integer;
203                  function GetLogThreadCount: Integer;                  function GetLogThreadCount: Integer;
204                    function GetArchiveThreadCount: Integer;
205                    function GetLiveThreadCount: Integer;
206                  function GetUserThreadCount: Integer;                  function GetUserThreadCount: Integer;
207                  function GetNewThread(Index: Integer): TThreadItem;                  function GetNewThread(Index: Integer): TThreadItem;
208                  function GetLogThread(Index: Integer): TThreadItem;                  function GetLogThread(Index: Integer): TThreadItem; overload;
209                    function GetArchiveThread(Index: Integer): TThreadItem;
210                    function GetLiveThread(Index: Integer): TThreadItem;
211                  function GetUserThread(Index: Integer): TThreadItem;                  function GetUserThread(Index: Integer): TThreadItem;
212                    function GetThreadCount(func :TThreadCount ): Integer;
213                    function GetThread(func :TThreadCount;const Index :Integer ): TThreadItem;
214                  procedure BeginUpdate;                  procedure BeginUpdate;
215                  procedure EndUpdate;                  procedure EndUpdate;
216                  property NodeExpand: Boolean read FExpand write FExpand;                  property NodeExpand: Boolean read FExpand write FExpand;
# Line 259  type Line 224  type
224                  property IsSETTINGTXT:  boolean read FIsSETTINGTXT write FIsSETTINGTXT;                  property IsSETTINGTXT:  boolean read FIsSETTINGTXT write FIsSETTINGTXT;
225                  property HEADTXTTime: TDateTime read FHEADTXTTime write FHEADTXTTime;                  property HEADTXTTime: TDateTime read FHEADTXTTime write FHEADTXTTime;
226                  property IsHEADTXT:     boolean read FIsHEADTXT write FIsHEADTXT;                  property IsHEADTXT:     boolean read FIsHEADTXT write FIsHEADTXT;
227          property TitlePictureURL: string read FTitlePictureURL write FTitlePictureURL;                  property TitlePictureURL: string read FTitlePictureURL write FTitlePictureURL;
228                    property Multiplicity: Integer read FMultiplicity write FMultiplicity;
229                    property Is2ch  : boolean       read FIs2ch     write FIs2ch;
230                    property NewThreadCount: Integer        read FNewThreadCount write FNewThreadCount;     //新着スレッドの数
231                    property LogThreadCount: Integer        read FLogThreadCount write FLogThreadCount;             //ログ有りスレッドの数
232                    property UserThreadCount: Integer       read FUserThreadCount write FUserThreadCount;   //?
233                    property LiveThreadCount: Integer       read FLiveThreadCount write     FLiveThreadCount;
234                    property ArchiveThreadCount: Integer read FArchiveThreadCount write FArchiveThreadCount;
235    
236                    property Cookie: string                         read FCookie write FCookie;
237                    property Expires: TDateTime                     read FExpires write FExpires;
238          end;          end;
239    
240          //スレ          //スレ
241          TThreadItem = class(TObject)          TThreadItem = class(TObject)
242          private          private
243                  FContext: DWORD;                                        // プラグインが自由に設定していい値(主にインスタンスが入る)                  FContext: DWORD;                                        // プラグインが自由に設定していい値(主にインスタンスが入る)
   
244                  FNo: Integer;                                                   //番号                  FNo: Integer;                                                   //番号
245                  FFileName: string;                              //スレッドファイル名                  FFileName: string;                              //スレッドファイル名
246                  FTitle: string;                                         //スレッドタイトル                  FTitle: string;                                         //スレッドタイトル
# Line 289  type Line 262  type
262                  FScrollTop: Integer;                    //スクロール位置                  FScrollTop: Integer;                    //スクロール位置
263                  FDownloadHost: string;          //今のホストと違う場合のホスト                  FDownloadHost: string;          //今のホストと違う場合のホスト
264                  FAgeSage: TGikoAgeSage;         //アイテムの上げ下げ                  FAgeSage: TGikoAgeSage;         //アイテムの上げ下げ
 //              FSPID: string;                                          //書き込み用SPID  
   
265                  FUpdate: Boolean;                  FUpdate: Boolean;
266                  FExpand: Boolean;                  FExpand: Boolean;
267                  FURL                                    : string;                               // このスレをブラウザで表示する際の URL                  FURL                                    : string;                               // このスレをブラウザで表示する際の URL
268                  FBoardPlugIn    : TBoardPlugIn; // このスレをサポートするプラグイン                  FJumpAddress : Integer;         //レス番号指定URLを踏んだときに指定されるレスの番号が入る
                 FFilePath                       : string;                               // このスレが保存されているパス  
   
269                  procedure SetLastModified(d: TDateTime);                  procedure SetLastModified(d: TDateTime);
270                  procedure SetRound(b: Boolean);                  procedure SetRound(b: Boolean);
271                  procedure SetRoundName(const s: string);                  procedure SetRoundName(const s: string);
272                    //procedure SetRoundName(const s: PChar);
273                  procedure SetKokomade(i: Integer);                  procedure SetKokomade(i: Integer);
274                  procedure SetUnRead(b: Boolean);                  procedure SetUnRead(b: Boolean);
275                  procedure SetScrollTop(i: Integer);                  procedure SetScrollTop(i: Integer);
276                  procedure Init;                  procedure Init;
277                  function GetCreateDate: TDateTime;                  function GetCreateDate: TDateTime;
278            function GetFilePath: String;
279          public          public
280                  constructor Create( inPlugIn : TBoardPlugIn; inURL : string );                  constructor Create(const inPlugIn : TBoardPlugIn; const inBoard : TBoard; inURL : string ); overload;
281                    constructor Create(const inPlugIn : TBoardPlugIn; const inBoard : TBoard;
282                                             const inURL : string; inExist: Boolean; const inFilename: string ); overload;
283    
284                  destructor Destroy; override;                  destructor Destroy; override;
285    
286                  function GetDatURL: string;                  function GetDatURL: string;
# Line 333  type Line 307  type
307                  property Size: Integer read FSize write FSize;                  property Size: Integer read FSize write FSize;
308                  property Round: Boolean read FRound write SetRound;                  property Round: Boolean read FRound write SetRound;
309                  property RoundName: string read FRoundName write SetRoundName;                  property RoundName: string read FRoundName write SetRoundName;
310                    //property RoundName: PChar read FRoundName write SetRoundName;
311    
312                  property IsLogFile: Boolean read FIsLogFile write FIsLogFile;                  property IsLogFile: Boolean read FIsLogFile write FIsLogFile;
313                  property ParentBoard: TBoard read FParentBoard write FParentBoard;                  property ParentBoard: TBoard read FParentBoard write FParentBoard;
# Line 344  type Line 319  type
319                  property Expand: Boolean read FExpand write FExpand;                  property Expand: Boolean read FExpand write FExpand;
320                  property DownloadHost: string read FDownloadHost write FDownloadHost;                  property DownloadHost: string read FDownloadHost write FDownloadHost;
321                  property AgeSage: TGikoAgeSage read FAgeSage write FAgeSage;                  property AgeSage: TGikoAgeSage read FAgeSage write FAgeSage;
 //              property SPID: string read FSPID write FSPID;  
322                  property CreateDate: TDateTime read GetCreateDate;                  property CreateDate: TDateTime read GetCreateDate;
323                  property        URL                                     : string                                read FURL write FURL;                  property        URL                                     : string                                read FURL write FURL;
324                  property        BoardPlugIn     : TBoardPlugIn  read FBoardPlugIn;                  property        FilePath                : string        read GetFilePath;
325                  property        FilePath                : string                                read FFilePath write FFilePath;                  property JumpAddress : Integer read FJumpAddress write FJumpAddress;
                 function        IsBoardPlugInAvailable : Boolean;  
326          end;          end;
327    
328            TBoardGroup = class(TStringList)
329        private
330          //検索結果リスト          FBoardPlugIn    : TBoardPlugIn; // この板をサポートするプラグイン
331  {       TSearchList = class(TList)      public
         private  
                 function GetThreadItem(index: integer): TThreadItem;  
                 procedure SetThreadItem(index: integer; value: TThreadItem);  
         public  
                 constructor Create;  
332                  destructor Destroy; override;                  destructor Destroy; override;
333                    procedure       Clear   ; override;
334            property        BoardPlugIn     : TBoardPlugIn  read FBoardPlugIn write FBoardPlugIn;
335        end;
336    
337                  property Items[index: integer]: TThreadItem read GetThreadItem write SetThreadItem;      // 特殊用途用TBoard
338        TSpecialBoard = class(TBoard)
339                  function Add(item: TThreadItem): integer;      public
340                  procedure Delete(index: integer);          function Add(item: TThreadItem): integer; overload;
341                  procedure Clear; override;          procedure Clear; overload;
342          end;}      end;
343    
344          function        BBSsFindBoardFromBBSID( inBBSID : string ) : TBoard;          function        BBSsFindBoardFromBBSID( inBBSID : string ) : TBoard;
345          function        BBSsFindBoardFromURL( inURL : string ) : TBoard;          function        BBSsFindBoardFromURL( inURL : string ) : TBoard;
# Line 376  type Line 347  type
347          function        BBSsFindThreadFromURL(const inURL : string ) : TThreadItem;          function        BBSsFindThreadFromURL(const inURL : string ) : TThreadItem;
348          function        ConvertDateTimeString( inDateTimeString : string) : TDateTime;          function        ConvertDateTimeString( inDateTimeString : string) : TDateTime;
349    
350        procedure    DestorySpecialBBS( inBBS : TBBS );
351    
352  var  var
353          BBSs            : array of TBBS;          BBSs            : array of TBBS;
354        BoardGroups : array of TBoardGroup;
355        SpecialBBS  : TBBS;
356        SpecialBoard: TSpecialBoard;
357    
358  implementation  implementation
359    
360  uses  uses
361          GikoSystem, RoundData, MojuUtils;          GikoSystem, RoundData, MojuUtils, DateUtils, IniFiles;
362    
363  const  const
364          BBS2CH_NAME:                                     string = '2ちゃんねる';          BBS2CH_NAME:                                     string = '2ちゃんねる';
# Line 397  const Line 373  const
373      HEADTXT_FILENAME:           string = 'head.html';      HEADTXT_FILENAME:           string = 'head.html';
374          //DEFAULT_LIST_COUNT:           Integer = 100;          //DEFAULT_LIST_COUNT:           Integer = 100;
375    
376  //      COLUMN_CATEGORY:         array[0..0] of string = ('カテゴリ名');  //! ログを持っているなら真を返す
377  //      COLUMN_BOARD:                   array[0..3] of string = ('板名', '取得数', '巡回予約', '前回巡回日時');  function CountLog(Item: TThreadItem): Boolean;
378  //      COLUMN_THREADITEM: array[0..3] of string = ('スレッド名', 'カウント', '巡回予約', '前回巡回日時');  begin
379            Result := Item.IsLogFile;
380    end;
381    //! 新着なら真を返す
382    function CountNew(Item: TThreadItem): Boolean;
383    begin
384            Result := Item.NewArrival;
385    end;
386    //! DAT落ちなら真を返す
387    function CountDat(Item: TThreadItem): Boolean;
388    begin
389            Result := (Item.AgeSage = gasArch);
390    end;
391    //! 生存スレなら真を返す
392    function CountLive(Item: TThreadItem): Boolean;
393    begin
394            Result := (Item.AgeSage <> gasArch);
395    end;
396    
397    //! 常に真
398    function CountAll(Item: TThreadItem): Boolean;
399    begin
400        Result := True;
401    end;
402    
403    
404    
405  // BBSID を用いる 2 ちゃんねるのみ探し出します  // BBSID を用いる 2 ちゃんねるのみ探し出します
406  // BBSID の使用は極力避けてください。  // BBSID の使用は極力避けてください。
# Line 407  const Line 408  const
408  function        BBSsFindBoardFromBBSID(  function        BBSsFindBoardFromBBSID(
409          inBBSID : string          inBBSID : string
410  ) : TBoard;  ) : TBoard;
411    var
412            i : Integer;
413            tmpBoard : TBoard;
414  begin  begin
415    
416          Result := BBSs[ 0 ].FindBBSID( inBBSID );  //      Result := BBSs[ 0 ].FindBBSID( inBBSID );
417            Result := nil;
418            if Length(BoardGroups) > 0 then begin
419                    for i := BoardGroups[0].Count - 1 downto 0 do begin
420                            tmpBoard := TBoard(BoardGroups[0].Objects[i]);
421                            if tmpBoard.Is2ch then begin
422                                    if AnsiCompareStr(tmpBoard.BBSID, inBBSID) = 0 then begin
423                                            Result := tmpBoard;
424                                            EXIT;
425                                    end;
426                            end;
427                    end;
428            end;
429    
430  end;  end;
431    {**********************************************
432    この関数は必ず板のURLの形式で渡してください。
433    pluginを使用するならば、ExtractBoardURL( inURL )
434    2chならば、GikoSys.Get2chThreadURL2BoardURL( inURL );
435    で変換してから呼び出してください。
436    **********************************************}
437  function        BBSsFindBoardFromURL(  function        BBSsFindBoardFromURL(
438          inURL   : string          inURL   : string
439  ) : TBoard;  ) : TBoard;
440  var  var
441          i                       : Integer;          i,p                     : Integer;
442            accept          : TAcceptType;
443            protocol, host, path, document, port, bookmark : string;
444  begin  begin
   
         for i := Length( BBSs ) - 1 downto 0 do begin  
                 Result := BBSs[ i ].FindBoardFromURL( inURL );  
                 if Result <> nil then  
                         Exit;  
         end;  
   
445          Result := nil;          Result := nil;
446            for i := Length(BoardGroups) - 1 downto 1 do begin
447                    accept := BoardGroups[i].BoardPlugIn.AcceptURL(inURL);
448                    if (accept = atBoard) or (accept = atThread) then begin
449                            if BoardGroups[i].Find(inURL, p) then begin
450                                    Result := TBoard(BoardGroups[i].Objects[p]);
451                                    Exit;
452                            end else begin
453                                    inURL := BoardGroups[i].BoardPlugIn.ExtractBoardURL(inURL);
454                                    if BoardGroups[i].Find(inURL, p) then begin
455                                            Result := TBoard(BoardGroups[i].Objects[p]);
456                                            Exit;
457                                    end;
458                            end;
459                    end;
460            end;
461            //ここにきたら、pluginを使わないやつらを調べる
462            if BoardGroups[0].Find(inURL, p) then
463                    Result := TBoard(BoardGroups[0].Objects[p]);
464                    
465            if (Result = nil) then begin
466                    GikoSys.ParseURI( inURL, protocol, host, path, document, port, bookmark );
467                    //ホストが2chならBBSIDで調べる
468                    if GikoSys.Is2chHost(host) then begin
469                            Result := BBSsFindBoardFromBBSID(GikoSys.URLToID( inURL ));
470                    end;
471            end;
472    
473  end;  end;
474    
# Line 434  function       BBSsFindBoardFromTitle( Line 476  function       BBSsFindBoardFromTitle(
476          inTitle : string          inTitle : string
477  ) : TBoard;  ) : TBoard;
478  var  var
479          i                               : Integer;          i,j                             : Integer;
480            tmpBoard                : TBoard;
481  begin  begin
482        Result := nil;
483          for i := Length( BBSs ) - 1 downto 0 do begin          for i := Length( BBSs ) - 1 downto 0 do begin
484                  Result := BBSs[ i ].FindBoardFromTitle( inTitle );                  for j := BoardGroups[i].Count - 1 downto 0 do begin
485                  if Result <> nil then                          tmpBoard := TBoard(BoardGroups[i].Objects[j]);
486                          Exit;                          if ( AnsiCompareStr(tmpBoard.Title, inTitle) = 0) then begin
487                                    Result := tmpBoard;
488                                    Exit;
489                            end;
490                    end;
491          end;          end;
492    
         Result := nil;  
   
493  end;  end;
494    
495  function        BBSsFindThreadFromURL(  function        BBSsFindThreadFromURL(
# Line 452  function       BBSsFindThreadFromURL( Line 497  function       BBSsFindThreadFromURL(
497  ) : TThreadItem;  ) : TThreadItem;
498  var  var
499          board                   : TBoard;          board                   : TBoard;
500            tmpThread               : TThreadItem;
501          boardURL        : string;          boardURL        : string;
502            protocol, host, path, document, port, bookmark : string;
503            BBSID, BBSKey : string;
504            i, bi : Integer;
505  begin  begin
506    
507          boardURL        := GikoSys.GetThreadURL2BoardURL( inURL );          boardURL        := GikoSys.GetThreadURL2BoardURL( inURL );
508          board                   := BBSsFindBoardFromURL( boardURL );          board                   := BBSsFindBoardFromURL( boardURL );
509          if board = nil then          if board = nil then
510                  Result := nil                  Result := nil
511          else          else begin
512                  Result := board.FindThreadFromURL( inURL );                  Result := board.FindThreadFromURL( inURL );
513                    //もしも2chの板なら
514                    if (Result = nil) and (board.Is2ch) then begin
515                            GikoSys.ParseURI( inURL, protocol, host, path, document, port, bookmark );
516                            GikoSys.Parse2chURL( inURL, path, document, BBSID, BBSKey );
517                            Result := board.FindThreadFromFileName(BBSKey + '.dat');
518                    end else if (Result = nil) and not (board.Is2ch) then begin
519                    //プラグイン系の探索(主にURLが途中で変更になった類)
520                            try
521                                    bi := Length(BoardGroups) - 1;
522                                    for i := 1 to bi do begin
523                                            if (BoardGroups[i].BoardPlugIn <> nil) and (Assigned(Pointer(BoardGroups[i].BoardPlugIn.Module))) then begin
524                                                    if BoardGroups[i].BoardPlugIn.AcceptURL( inURL ) = atThread then begin
525                                                            tmpThread               := TThreadItem.Create( BoardGroups[i].BoardPlugIn, Board, inURL );
526                                                            if not board.IsThreadDatRead then begin
527                                                                    GikoSys.ReadSubjectFile( board );
528                                                            end;
529                                                            Result := Board.FindThreadFromFileName( tmpThread.FileName );
530                                                            tmpThread.Free;
531                                                            Break;
532                                                    end;
533                                            end;
534                                    end;
535                            except
536                    Result := nil;
537                            end;
538                    end;
539            end;
540    
541  end;  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;
564    
565  (*************************************************************************  (*************************************************************************
566   *機能名:TBBSコンストラクタ   *機能名:TBBSコンストラクタ
# Line 549  var Line 647  var
647          i: Integer;          i: Integer;
648  begin  begin
649          if not IsBoardFileRead then          if not IsBoardFileRead then
650          GikoSys.ReadBoardFile( Self );          GikoSys.ReadBoardFile( Self );
651          for i := Count - 1 downto 0 do begin          for i := Count - 1 downto 0 do begin
652                  Result := Items[ i ].FindBoardFromTitle(Title);                  Result := Items[ i ].FindBoardFromTitle(Title);
653                  if Result <> nil then                  if Result <> nil then
# Line 566  var Line 664  var
664          i                                       : Integer;          i                                       : Integer;
665  begin  begin
666          if not IsBoardFileRead then          if not IsBoardFileRead then
667          GikoSys.ReadBoardFile( Self );          GikoSys.ReadBoardFile( Self );
668          for i := Count - 1 downto 0 do begin          for i := Count - 1 downto 0 do begin
669                  Result := Items[ i ].FindBoardFromURL( inURL );                  Result := Items[ i ].FindBoardFromURL( inURL );
670                  if Result <> nil then                  if Result <> nil then
# Line 623  end; Line 721  end;
721  procedure TBBS.SetSelectText(s: string);  procedure TBBS.SetSelectText(s: string);
722  begin  begin
723          FSelectText := s;          FSelectText := s;
724          ShortSelectText := ZenToHan(s);          ShortSelectText := CustomStringReplace(ZenToHan(s), ' ', '');
725  end;  end;
726    
727  {class function TBBS.GetColumnName(Index: Integer): string;  {class function TBBS.GetColumnName(Index: Integer): string;
# Line 642  end;} Line 740  end;}
740  constructor TCategory.Create;  constructor TCategory.Create;
741  begin  begin
742          inherited;          inherited;
743    
744            Duplicates              := dupIgnore;
745            CaseSensitive   := False;
746            //Sorted                                := True;
747  end;  end;
748    
749  destructor TCategory.Destroy;  destructor TCategory.Destroy;
# Line 669  end; Line 771  end;
771    
772  procedure TCategory.Delete(index: integer);  procedure TCategory.Delete(index: integer);
773  begin  begin
774          if Items[index] <> nil then      inherited Delete(index);
                 TBoard(Items[index]).Free;  
         inherited Delete(index);  
775  end;  end;
776    
777  procedure TCategory.Clear;  procedure TCategory.Clear;
# Line 785  end;} Line 885  end;}
885  //===================  //===================
886  procedure TBoard.Init;  procedure TBoard.Init;
887  begin  begin
888            Duplicates              := dupIgnore;
889            CaseSensitive   := False;
890            //Sorted                                := True;
891    
892          FNo := 0;          FNo := 0;
893          FTitle := '';          FTitle := '';
894          FBBSID := '';          FBBSID := '';
# Line 795  begin Line 899  begin
899          FLastGetTime := ZERO_DATE;          FLastGetTime := ZERO_DATE;
900          FIsThreadDatRead := False;          FIsThreadDatRead := False;
901          FUnRead := 0;          FUnRead := 0;
902            FMultiplicity := 0;
903  //      FListStyle := vsReport;  //      FListStyle := vsReport;
904  //      FItemNoVisible := True;  //      FItemNoVisible := True;
905    
# Line 822  begin Line 927  begin
927          if inPlugIn = nil then begin          if inPlugIn = nil then begin
928                  // subject.txt の保存パスを設定                  // subject.txt の保存パスを設定
929                  GikoSys.ParseURI( inURL, protocol, host, path, document, port, bookmark );                  GikoSys.ParseURI( inURL, protocol, host, path, document, port, bookmark );
930                  if GikoSys.Is2chHost( host ) then                  if GikoSys.Is2chHost( host ) then begin
931                            Self.Is2ch := True;
932                          FilePath :=                          FilePath :=
933                                  IncludeTrailingPathDelimiter( GikoSys.Setting.LogFolder ) +                                  GikoSys.Setting.LogFolderP  +
934                                  BBS2CH_LOG_FOLDER + PATH_DELIM + BBSID + PATH_DELIM + SUBJECT_FILENAME                                  BBS2CH_LOG_FOLDER + PATH_DELIM + BBSID + PATH_DELIM + SUBJECT_FILENAME
935                  else                  end else begin
936                            Self.Is2ch := False;
937                          FilePath :=                          FilePath :=
938                                  IncludeTrailingPathDelimiter( GikoSys.Setting.LogFolder ) +                                  GikoSys.Setting.LogFolderP +
939                                  EXTERNAL_LOG_FOLDER + PATH_DELIM + host + PATH_DELIM + BBSID + PATH_DELIM + SUBJECT_FILENAME                                  EXTERNAL_LOG_FOLDER + PATH_DELIM + host + PATH_DELIM + BBSID + PATH_DELIM + SUBJECT_FILENAME
940                    end;
941          end else begin          end else begin
942                  // プラグインに TBoardItem が作成されたことを伝える                  // プラグインに TBoardItem が作成されたことを伝える
943                  inPlugIn.CreateBoardItem( DWORD( Self ) );                  inPlugIn.CreateBoardItem( DWORD( Self ) );
944                    //Self.Is2ch := False;  //plugin側で設定する
945          end;          end;
946    
947  end;  end;
# Line 950  begin Line 1059  begin
1059          end;          end;
1060  end;  end;
1061    
1062  function TBoard.GetIndexFromURL(const URL: string): Integer;  function TBoard.GetIndexFromURL(const URL: string; reverse : Boolean = False): Integer;
1063    var
1064            i : Integer;
1065  begin  begin
1066          Result := IndexOf( URL );          if not reverse then
1067                    Result := IndexOf( URL )
1068            else begin
1069            Result := -1;
1070                    for i := Self.Count - 1 downto 0 do begin
1071                            if Strings[i] = URL then begin
1072                                    Result := i;
1073                                    break;
1074                            end;
1075                    end;
1076            end;
1077  end;  end;
1078    
1079  function TBoard.FindThreadFromURL(const inURL : string ) : TThreadItem;  function TBoard.FindThreadFromURL(const inURL : string ) : TThreadItem;
# Line 989  procedure TBoard.LoadSettings; Line 1110  procedure TBoard.LoadSettings;
1110  var  var
1111          ini: TMemIniFile;          ini: TMemIniFile;
1112          FileName: string;          FileName: string;
1113      tmp: string;          tmp: string;
1114  begin  begin
1115          if Length( FilePath ) > 0 then          if Length( FilePath ) > 0 then
1116                  FileName := ExtractFilePath( FilePath ) + FOLDER_INI_FILENAME                  FileName := ExtractFilePath( FilePath ) + FOLDER_INI_FILENAME
1117          else          else
1118                  FileName := IncludeTrailingPathDelimiter( GikoSys.Setting.LogFolder )                  FileName := GikoSys.Setting.LogFolderP
1119                                                          + BBS2CH_LOG_FOLDER + PATH_DELIM + BBSID + PATH_DELIM + FOLDER_INI_FILENAME;                                                          + BBS2CH_LOG_FOLDER + PATH_DELIM + BBSID + PATH_DELIM + FOLDER_INI_FILENAME;
1120    
1121          if not FileExists(FileName) then          if not FileExists(FileName) then
# Line 1021  begin Line 1142  begin
1142                  FUnRead := ini.ReadInteger('Status', 'UnRead', 0);                  FUnRead := ini.ReadInteger('Status', 'UnRead', 0);
1143                  FSPID := ini.ReadString('Cookie', 'SPID', '');                  FSPID := ini.ReadString('Cookie', 'SPID', '');
1144                  FPON := ini.ReadString('Cookie', 'PON', '');                  FPON := ini.ReadString('Cookie', 'PON', '');
1145                    FCookie  := ini.ReadString('Cookie', 'Cookie', '');
1146                    tmp := ini.ReadString('Cookie', 'Expires', DateTimeToStr(ZERO_DATE));
1147                    FExpires := ConvertDateTimeString(tmp);
1148                  FKotehanName := ini.ReadString('Kotehan', 'Name', '');                  FKotehanName := ini.ReadString('Kotehan', 'Name', '');
1149                  FKotehanMail := ini.ReadString('Kotehan', 'Mail', '');                  FKotehanMail := ini.ReadString('Kotehan', 'Mail', '');
1150    
# Line 1039  begin Line 1163  begin
1163          if Length( FilePath ) > 0 then          if Length( FilePath ) > 0 then
1164                  FileName := ExtractFilePath( FilePath )                  FileName := ExtractFilePath( FilePath )
1165          else          else
1166                  FileName := IncludeTrailingPathDelimiter( GikoSys.Setting.LogFolder )                  FileName := GikoSys.Setting.LogFolderP
1167                                                          + BBS2CH_LOG_FOLDER + PATH_DELIM + BBSID + PATH_DELIM;                                                          + BBS2CH_LOG_FOLDER + PATH_DELIM + BBSID + PATH_DELIM;
1168          if not GikoSys.DirectoryExistsEx(FileName) then          if not GikoSys.DirectoryExistsEx(FileName) then
1169                  GikoSys.ForceDirectoriesEx(FileName);                  GikoSys.ForceDirectoriesEx(FileName);
# Line 1055  begin Line 1179  begin
1179                  ini.WriteInteger('Status', 'UnRead', FUnRead);                  ini.WriteInteger('Status', 'UnRead', FUnRead);
1180                  ini.WriteString('Cookie', 'SPID', FSPID);                  ini.WriteString('Cookie', 'SPID', FSPID);
1181                  ini.WriteString('Cookie', 'PON', FPON);                  ini.WriteString('Cookie', 'PON', FPON);
1182                    ini.WriteString('Cookie', 'Cookie', FCookie);
1183                    ini.WriteDateTime('Cookie', 'Expires', FExpires);
1184                  ini.WriteString('Kotehan', 'Name', FKotehanName);                  ini.WriteString('Kotehan', 'Name', FKotehanName);
1185                  ini.WriteString('Kotehan', 'Mail', FKotehanMail);                  ini.WriteString('Kotehan', 'Mail', FKotehanMail);
1186    
# Line 1101  begin Line 1227  begin
1227      except      except
1228          if( inDateTimeString[5] = '/' ) and ( inDateTimeString[8] = '/' ) then begin          if( inDateTimeString[5] = '/' ) and ( inDateTimeString[8] = '/' ) then begin
1229              y := StrToIntDef( Copy(inDateTimeString, 1, 4), 1970 );              y := StrToIntDef( Copy(inDateTimeString, 1, 4), 1970 );
1230              m := StrToIntDef( Copy(inDateTimeString, 6, 2), 1 );                          m := StrToIntDef( Copy(inDateTimeString, 6, 2), 1 );
1231              d := StrToIntDef( Copy(inDateTimeString, 9, 2), 1 );              d := StrToIntDef( Copy(inDateTimeString, 9, 2), 1 );
1232              hour := 0; min  := 0; sec  := 0;              hour := 0; min  := 0; sec  := 0;
1233    
# Line 1128  begin Line 1254  begin
1254    
1255     // Result := inDateTimeString;     // Result := inDateTimeString;
1256  end;  end;
1257  // サブジェクトURL取得  //! サブジェクトURL取得
1258  function TBoard.GetReadCgiURL: string;  function TBoard.GetReadCgiURL: string;
1259  begin  begin
         //Result := URL + SUBJECT_FILENAME;  
         //Result := GikoSys.UrlToServer(URL)  
         //                              + 'test/read.cgi/' + BBSID + '/?raw=0.0';  
1260          Result := URL + SUBJECT_FILENAME;          Result := URL + SUBJECT_FILENAME;
1261    
1262  end;  end;
1263    
1264  // サブジェクトファイル名取得(パス+ファイル名)  //! サブジェクトファイル名取得(パス+ファイル名)
1265  function TBoard.GetSubjectFileName: string;  function TBoard.GetSubjectFileName: string;
1266  begin  begin
1267          if Length( FilePath ) > 0 then          if Length( FilePath ) > 0 then
1268                  Result := FilePath                  Result := FilePath
1269          else          else
1270                  Result := IncludeTrailingPathDelimiter( GikoSys.Setting.LogFolder )                  Result := GikoSys.Setting.LogFolderP
1271                                                  + BBS2CH_LOG_FOLDER + PATH_DELIM + BBSID + PATH_DELIM + SUBJECT_FILENAME;                                                  + BBS2CH_LOG_FOLDER + PATH_DELIM + BBSID + PATH_DELIM + SUBJECT_FILENAME;
1272  end;  end;
1273    
1274  // インデックスファイル名(folder.idx)取得(パス+ファイル名)  //! インデックスファイル名(folder.idx)取得(パス+ファイル名)
1275  function TBoard.GetFolderIndexFileName: string;  function TBoard.GetFolderIndexFileName: string;
1276  begin  begin
1277          if Length( FilePath ) > 0 then          if Length( FilePath ) > 0 then
1278                  Result := ExtractFilePath( FilePath ) + FOLDER_INDEX_FILENAME                  Result := ExtractFilePath( FilePath ) + FOLDER_INDEX_FILENAME
1279          else          else
1280                  Result := IncludeTrailingPathDelimiter( GikoSys.Setting.LogFolder )                  Result := GikoSys.Setting.LogFolderP
1281                                                  + BBS2CH_LOG_FOLDER + PATH_DELIM + BBSID + PATH_DELIM + FOLDER_INDEX_FILENAME;                                                  + BBS2CH_LOG_FOLDER + PATH_DELIM + BBSID + PATH_DELIM + FOLDER_INDEX_FILENAME;
1282  end;  end;
1283  //SETTING.TXTのファイル名取得  //! SETTING.TXTのファイル名取得
1284  function TBoard.GetSETTINGTXTFileName: string;  function TBoard.GetSETTINGTXTFileName: string;
1285  begin  begin
1286          if Length( FilePath ) > 0 then          if Length( FilePath ) > 0 then
1287                  Result := ExtractFilePath( FilePath ) + SETTINGTXT_FILENAME                  Result := ExtractFilePath( FilePath ) + SETTINGTXT_FILENAME
1288          else          else
1289                  Result := IncludeTrailingPathDelimiter( GikoSys.Setting.LogFolder )                  Result := GikoSys.Setting.LogFolderP
1290                                                  + BBS2CH_LOG_FOLDER + PATH_DELIM + BBSID + PATH_DELIM + SETTINGTXT_FILENAME;                                                  + BBS2CH_LOG_FOLDER + PATH_DELIM + BBSID + PATH_DELIM + SETTINGTXT_FILENAME;
1291  end;  end;
1292    
# Line 1172  begin Line 1295  begin
1295          if Length( FilePath ) > 0 then          if Length( FilePath ) > 0 then
1296                  Result := ExtractFilePath( FilePath ) + HEADTXT_FILENAME                  Result := ExtractFilePath( FilePath ) + HEADTXT_FILENAME
1297          else          else
1298                  Result := IncludeTrailingPathDelimiter( GikoSys.Setting.LogFolder )                  Result := GikoSys.Setting.LogFolderP
1299                                                  + BBS2CH_LOG_FOLDER + PATH_DELIM + BBSID + PATH_DELIM + HEADTXT_FILENAME;                                                  + BBS2CH_LOG_FOLDER + PATH_DELIM + BBSID + PATH_DELIM + HEADTXT_FILENAME;
1300  end;  end;
1301  function TBoard.GetTitlePictureFileName: string;  function TBoard.GetTitlePictureFileName: string;
# Line 1186  begin Line 1309  begin
1309                  if Length( FilePath ) > 0 then                  if Length( FilePath ) > 0 then
1310                          Result := ExtractFilePath( FilePath ) + tmpName                          Result := ExtractFilePath( FilePath ) + tmpName
1311                  else                  else
1312                          Result := IncludeTrailingPathDelimiter( GikoSys.Setting.LogFolder )                          Result := GikoSys.Setting.LogFolderP
1313                                                          + BBS2CH_LOG_FOLDER + PATH_DELIM + BBSID + PATH_DELIM + tmpName;                                                          + BBS2CH_LOG_FOLDER + PATH_DELIM + BBSID + PATH_DELIM + tmpName;
1314          end;          end;
1315  end;  end;
1316    
1317  // スレ立て送信URL  // スレ立て送信URL
1318  function TBoard.GetSendURL: string;  function TBoard.GetSendURL: string;
 var  
         Protocol, Host, Path, Document, Port, Bookmark : string;  
1319  begin  begin
1320      Result := GikoSys.UrlToServer(URL);      Result := GikoSys.UrlToServer(URL);
1321      GikoSys.ParseURI( URL, Protocol,Host, Path, Document, Port, Bookmark );          if Self.Is2ch then
     if GikoSys.Is2chHost(Host) then  
1322          Result := Result + 'test/bbs.cgi'          Result := Result + 'test/bbs.cgi'
1323      else      else
1324          Result := Result + 'test/subbbs.cgi';          Result := Result + 'test/subbbs.cgi';
1325    
1326  end;  end;
1327    
1328  procedure TBoard.SetRound(b: Boolean);  procedure TBoard.SetRound(b: Boolean);
# Line 1264  begin Line 1385  begin
1385          if FUpdate then          if FUpdate then
1386                  FModified := True;                  FModified := True;
1387  end;  end;
1388    //! funcの条件に一致するスレッドの数を返す
1389  function TBoard.GetNewThreadCount: Integer;  function TBoard.GetThreadCount(func :TThreadCount ): Integer;
1390  var  var
1391          i: Integer;          i: Integer;
1392  begin  begin
# Line 1273  begin Line 1394  begin
1394          if Length( ParentCategory.ParenTBBS.ShortSelectText ) = 0 then          if Length( ParentCategory.ParenTBBS.ShortSelectText ) = 0 then
1395          begin          begin
1396                  for i := 0 to Count - 1 do begin                  for i := 0 to Count - 1 do begin
1397                          if Items[i].NewArrival then                          if func(Items[i]) then
1398                                  inc(Result);                                  inc(Result);
1399                  end;                  end;
1400          end else begin          end else begin
1401                  for i := 0 to Count - 1 do begin                  for i := 0 to Count - 1 do begin
1402                          if Items[i].NewArrival then                          if func(Items[i]) then
1403                          begin                          begin
1404                                  if Items[i].ShortTitle = '' then                                  if Items[i].ShortTitle = '' then
1405                                          Items[i].ShortTitle := ZenToHan(Items[i].Title);                                          Items[i].ShortTitle := CustomStringReplace(ZenToHan(Items[i].Title), ' ', '');
1406                                  if AnsiPos(ParentCategory.ParenTBBS.ShortSelectText, Items[i].ShortTitle) <> 0 then                                  if AnsiPos(ParentCategory.ParenTBBS.ShortSelectText, Items[i].ShortTitle) <> 0 then
1407                                          inc(Result);                                          inc(Result);
1408                          end;                          end;
1409                  end;                  end;
1410          end;          end;
1411  end;  end;
1412    //! 新着スレッドの数を取得する
1413    function TBoard.GetNewThreadCount: Integer;
1414    begin
1415            Result := GetThreadCount(CountNew);
1416    end;
1417    //! ログ有りスレッドの数を取得する
1418  function TBoard.GetLogThreadCount: Integer;  function TBoard.GetLogThreadCount: Integer;
 var  
         i: Integer;  
1419  begin  begin
1420          Result := 0;          Result := GetThreadCount(CountLog);
         if Length( ParentCategory.ParenTBBS.ShortSelectText ) = 0 then  
         begin  
                 for i := 0 to Count - 1 do begin  
                         if Items[i].IsLogFile then  
                                 inc(Result);  
                 end;  
         end else begin  
                 for i := 0 to Count - 1 do begin  
                         if Items[i].IsLogFile then  
                         begin  
                                 if Items[i].ShortTitle = '' then  
                                         Items[i].ShortTitle := ZenToHan(Items[i].Title);  
                                 if AnsiPos(ParentCategory.ParenTBBS.ShortSelectText, Items[i].ShortTitle) <> 0 then  
                                         inc(Result);  
                         end;  
                 end;  
         end;  
1421  end;  end;
1422    //! 絞込み条件に一致するスレッドの数を取得する
1423  function TBoard.GetUserThreadCount: Integer;  function TBoard.GetUserThreadCount: Integer;
 var  
         i: Integer;  
1424  begin  begin
1425          Result := 0;          Result := GetThreadCount(CountAll);
         if Length( ParentCategory.ParenTBBS.ShortSelectText ) = 0 then  
                 Result := Count  
         else  
                 for i := 0 to Count - 1 do begin  
                         if Items[i].ShortTitle = '' then  
                                 Items[i].ShortTitle := ZenToHan(Items[i].Title);  
                         if AnsiPos(ParentCategory.ParenTBBS.ShortSelectText, Items[i].ShortTitle) <> 0 then  
                                 inc(Result);  
                 end;  
1426  end;  end;
1427    //! DAT落ちスレッドの数を取得する
1428  function TBoard.GetNewThread(Index: Integer): TThreadItem;  function TBoard.GetArchiveThreadCount: Integer;
1429    begin
1430            Result := GetThreadCount(CountDat);
1431    end;
1432    //! 生存スレッドの数を取得する
1433    function TBoard.GetLiveThreadCount: Integer;
1434    begin
1435            Result := GetThreadCount(CountLive);
1436    end;
1437    //! funcの条件に適合するIndex番目のスレッドを取得する
1438    function TBoard.GetThread(func :TThreadCount;const Index :Integer ): TThreadItem;
1439  var  var
1440          i: Integer;          i: Integer;
1441          Cnt: Integer;          Cnt: Integer;
# Line 1339  begin Line 1445  begin
1445          if Length( ParentCategory.ParenTBBS.ShortSelectText ) = 0 then          if Length( ParentCategory.ParenTBBS.ShortSelectText ) = 0 then
1446          begin          begin
1447                  for i := 0 to Count - 1 do begin                  for i := 0 to Count - 1 do begin
1448                          if Items[i].NewArrival then                          if func(Items[i]) then begin
                                                                         begin  
1449                                  if Index = Cnt then begin                                  if Index = Cnt then begin
1450                                          Result := Items[i];                                          Result := Items[i];
1451                                          Exit;                                          Exit;
# Line 1350  begin Line 1455  begin
1455                  end;                  end;
1456          end else begin          end else begin
1457                  for i := 0 to Count - 1 do begin                  for i := 0 to Count - 1 do begin
1458                          if Items[i].NewArrival then                          if func(Items[i]) then begin
1459                          begin                                  if Length(Items[i].ShortTitle) = 0 then
1460                                  if Items[i].ShortTitle = '' then                                          Items[i].ShortTitle := CustomStringReplace(ZenToHan(Items[i].Title), ' ', '');
                                         Items[i].ShortTitle := ZenToHan(Items[i].Title);  
1461                                  if AnsiPos(ParentCategory.ParenTBBS.ShortSelectText, Items[i].ShortTitle) <> 0 then begin                                  if AnsiPos(ParentCategory.ParenTBBS.ShortSelectText, Items[i].ShortTitle) <> 0 then begin
1462                                          if Index = Cnt then begin                                          if Index = Cnt then begin
1463                                                  Result := Items[i];                                                  Result := Items[i];
# Line 1365  begin Line 1469  begin
1469                  end;                  end;
1470          end;          end;
1471  end;  end;
1472    //! DAT落ちスレッドでIndex番目のスレッドを取得する
1473    function TBoard.GetArchiveThread(Index: Integer): TThreadItem;
1474    begin
1475            Result := GetThread(CountDat, Index);
1476    end;
1477    //! 生存スレッドでIndex番目のスレッドを取得する
1478    function TBoard.GetLiveThread(Index: Integer): TThreadItem;
1479    begin
1480            Result := GetThread(CountLive, Index);
1481    end;
1482    //! 新着スレッドでIndex番目のスレッドを取得する
1483    function TBoard.GetNewThread(Index: Integer): TThreadItem;
1484    begin
1485            Result := GetThread(CountNew, Index);
1486    end;
1487    //! LogありスレッドのIndex番目のスレッドを取得する
1488  function TBoard.GetLogThread(Index: Integer): TThreadItem;  function TBoard.GetLogThread(Index: Integer): TThreadItem;
 var  
         i: Integer;  
         Cnt: Integer;  
1489  begin  begin
1490          Cnt := 0;          Result := GetThread(CountLog, Index);
         if Length( ParentCategory.ParenTBBS.ShortSelectText ) = 0 then  
         begin  
                 for i := 0 to Count - 1 do begin  
                         if Items[i].IsLogFile then  
                                                                         begin  
                                 if Index = Cnt then begin  
                                         Result := Items[i];  
                                         Exit;  
                                 end;  
                                 inc(Cnt);  
                         end;  
                 end;  
         end else begin  
                 for i := 0 to Count - 1 do begin  
                         if Items[i].IsLogFile then  
                                 begin  
                                         if Items[i].ShortTitle = '' then  
                                                 Items[i].ShortTitle := ZenToHan(Items[i].Title);  
                                         if AnsiPos(ParentCategory.ParenTBBS.ShortSelectText, Items[i].ShortTitle) <> 0 then begin  
                                                 if Index = Cnt then begin  
                                                         Result := Items[i];  
                                                         Exit;  
                                         end;  
                                         inc(Cnt);  
                                 end;  
                         end;  
                 end;  
         end;  
         Result := nil;  
1491  end;  end;
1492    //! 絞込みでIndex番目のスレッドを取得する
1493  function TBoard.GetUserThread(Index: Integer): TThreadItem;  function TBoard.GetUserThread(Index: Integer): TThreadItem;
 var  
         i: Integer;  
         Cnt: Integer;  
1494  begin  begin
1495          Result := nil;          Result := GetThread(CountAll, Index);
         Cnt := 0;  
         if Length( ParentCategory.ParenTBBS.ShortSelectText ) = 0 then  
         begin  
                 for i := 0 to Count - 1 do begin  
                         if Index = Cnt then  
                         begin  
                                 Result := Items[ i ];  
                                 Exit;  
                         end;  
                         inc( Cnt );  
                 end;  
         end else begin  
                 for i := 0 to Count - 1 do begin  
                         if Items[i].ShortTitle = '' then  
                                 Items[i].ShortTitle := ZenToHan(Items[i].Title);  
                         if AnsiPos(ParentCategory.ParenTBBS.ShortSelectText, Items[i].ShortTitle) <> 0 then begin  
                                 if Index = Cnt then begin  
                                         Result := Items[i];  
                                         Exit;  
                                 end;  
                                 inc(Cnt);  
                         end;  
                 end;  
         end;  
1496  end;  end;
1497    
1498  procedure TBoard.BeginUpdate;  procedure TBoard.BeginUpdate;
# Line 1445  begin Line 1505  begin
1505          FUpdate := True;          FUpdate := True;
1506  end;  end;
1507    
 {class function TBoard.GetColumnName(Index: Integer): string;  
 begin  
         Result := COLUMN_THREADITEM[Index];  
 end;  
   
 class function TBoard.GetColumnCount: Integer;  
 begin  
         Result := Length(COLUMN_THREADITEM);  
 end;}  
   
1508  //constructor TThreadItem.Create(AOwner: TComponent);  //constructor TThreadItem.Create(AOwner: TComponent);
1509  procedure TThreadItem.Init;  procedure TThreadItem.Init;
1510  begin  begin
# Line 1476  begin Line 1526  begin
1526    
1527          FUpdate := True;          FUpdate := True;
1528          FURL := '';          FURL := '';
1529          FBoardPlugIn := nil;          FJumpAddress := 0;
1530  end;  end;
1531    
1532  // *************************************************************************  // *************************************************************************
1533  // 外部板プラグインを指定したコンストラクタ  // 外部板プラグインを指定したコンストラクタ
1534  // *************************************************************************  // *************************************************************************
1535  constructor TThreadItem.Create(  constructor TThreadItem.Create(
1536          inPlugIn        : TBoardPlugIn;          const inPlugIn : TBoardPlugIn;
1537          inURL                   : string          const inBoard : TBoard;
1538            inURL : string
1539  );  );
1540  var  var
1541          foundPos                        : Integer;          foundPos                        : Integer;
# Line 1496  begin Line 1547  begin
1547    
1548          inherited Create;          inherited Create;
1549          Init;          Init;
1550            FParentBoard    := inBoard;
1551          FBoardPlugIn    := inPlugIn;          //FBoardPlugIn  := inPlugIn;
1552          URL                                             := inURL;          URL                             := inURL;
1553    
1554          if inPlugIn = nil then begin          if inPlugIn = nil then begin
1555                  foundPos := Pos( READ_PATH, inURL );                  foundPos := Pos( READ_PATH, inURL );
# Line 1506  begin Line 1557  begin
1557                          // dat の保存パスを設定                          // dat の保存パスを設定
1558                          GikoSys.ParseURI( inURL, protocol, host, path, document, port, bookmark );                          GikoSys.ParseURI( inURL, protocol, host, path, document, port, bookmark );
1559                          GikoSys.Parse2chURL( inURL, path, document, BBSID, BBSKey );                          GikoSys.Parse2chURL( inURL, path, document, BBSID, BBSKey );
                         if GikoSys.Is2chHost( host ) then  
                                 FilePath :=  
                                         IncludeTrailingPathDelimiter( GikoSys.Setting.LogFolder ) +  
                                         BBS2CH_LOG_FOLDER + PATH_DELIM + BBSID + PATH_DELIM + BBSKey + '.dat'  
                         else  
                                 FilePath :=  
                                         IncludeTrailingPathDelimiter( GikoSys.Setting.LogFolder ) +  
                                         EXTERNAL_LOG_FOLDER + PATH_DELIM + host + PATH_DELIM + BBSID + PATH_DELIM + BBSKey + '.dat';  
1560                          FileName        := BBSKey + '.dat';                          FileName        := BBSKey + '.dat';
1561                          IsLogFile       := FileExists( FilePath );                          IsLogFile       := FileExists( FilePath );
1562                          URL                             := GikoSys.Get2chBrowsableThreadURL( inURL );                          URL                             := GikoSys.Get2chBrowsableThreadURL( inURL );
# Line 1524  begin Line 1567  begin
1567          end;          end;
1568    
1569  end;  end;
   
1570  // *************************************************************************  // *************************************************************************
1571  // デストラクタ  // 外部板プラグインを指定したコンストラクタ Log有りかどうか判断済み
1572    // FileNameも取得済み → ReadSubject用
1573  // *************************************************************************  // *************************************************************************
1574  destructor TThreadItem.Destroy;  constructor TThreadItem.Create(
1575            const inPlugIn : TBoardPlugIn;
1576            const inBoard : TBoard;
1577            const inURL : string;
1578            inExist: Boolean;
1579            const inFilename: string
1580    );
1581  begin  begin
1582    
1583          // プラグインに TThreadItem が破棄されたことを伝える          inherited Create;
1584          if IsBoardPlugInAvailable then          Init;
1585                  FBoardPlugIn.DisposeThreadItem( DWORD( Self ) );          FParentBoard    := inBoard;
1586            URL                             := inURL;
1587    
1588          inherited;          if inPlugIn = nil then begin
1589                    // dat の保存パスを設定
1590                    FileName        := inFilename;
1591                    IsLogFile       := inExist;
1592            URL                             := inURL;
1593            end else begin
1594                    // プラグインに TThreadItem が作成されたことを伝える
1595                    inPlugIn.CreateThreadItem( DWORD( Self ) );
1596            end;
1597    
1598  end;  end;
   
1599  // *************************************************************************  // *************************************************************************
1600  // 外部板プラグインが使用可能か  // デストラクタ
1601  // *************************************************************************  // *************************************************************************
1602  function        TThreadItem.IsBoardPlugInAvailable : Boolean;  destructor TThreadItem.Destroy;
1603  begin  begin
1604    
1605          repeat          // プラグインに TThreadItem が破棄されたことを伝える
1606                  if BoardPlugIn = nil then          if Self.ParentBoard.IsBoardPlugInAvailable then
1607                          Break;                  Self.ParentBoard.BoardPlugIn.DisposeThreadItem( DWORD( Self ) );
   
                 if not Assigned( Pointer( BoardPlugIn.Module ) ) then  
                         Break;  
   
                 Result := True;  
                 Exit;  
         until True;  
1608    
1609          Result := False;          inherited;
1610    
1611  end;  end;
1612    
# Line 1623  begin Line 1673  begin
1673          end;          end;
1674  end;  end;
1675    
 {function TThreadItem.GetOldDatgzURL: string;  
 var  
         Protocol, Host, Path, Document, Port, Bookmark: string;  
 begin  
         Result := Format('%s%s/%.3s/%s.gz', [ParentBoard.URL,  
                                                                                                                                                          'kako',  
                                                                                                                                                          FileName,  
                                                                                                                                                          FileName]);  
         if FDownloadHost <> '' then begin  
                 ParseURI(Result, Protocol, Host, Path, Document, Port, Bookmark);  
                 Result := Format('%s://%s%s%s', [Protocol,  
                                                                                                                                                  DownloadHost,  
                                                                                                                                                  Path,  
                                                                                                                                                  Document]);  
   
         end;  
 end;}  
   
1676  function TThreadItem.GetOfflawCgiURL(const SessionID: string): string;  function TThreadItem.GetOfflawCgiURL(const SessionID: string): string;
 //var  
 //      Protocol, Host, Path, Document, Port, Bookmark: string;  
1677  begin  begin
 //      Result := GikoSys.UrlToServer(ParentBoard.URL)  
 //                                      + 'test/offlaw.cgi/' + ParentBoard.BBSID + '/'  
 //                                      + ChangeFileExt(FileName, '') + '/?raw=.0&sid=' + HttpEncode(SessionID);  
1678          if FDownloadHost = '' then begin          if FDownloadHost = '' then begin
1679                  Result := GikoSys.UrlToServer(ParentBoard.URL)                  Result := GikoSys.UrlToServer(ParentBoard.URL)
1680                                                  + 'test/offlaw.cgi/' + ParentBoard.BBSID + '/'                                                  + 'test/offlaw.cgi/' + ParentBoard.BBSID + '/'
# Line 1658  begin Line 1685  begin
1685                  Result := 'http://' + FDownloadHost                  Result := 'http://' + FDownloadHost
1686                                                  + '/test/offlaw.cgi/' + ParentBoard.BBSID + '/'                                                  + '/test/offlaw.cgi/' + ParentBoard.BBSID + '/'
1687                                                  + ChangeFileExt(FileName, '') + '/?raw=.0&sid=' + HttpEncode(SessionID);                                                  + ChangeFileExt(FileName, '') + '/?raw=.0&sid=' + HttpEncode(SessionID);
 //              Result := Format('%s://%s%s%s', [Protocol,  
 //                                                                                                                                               DownloadHost,  
 //                                                                                                                                               Path,  
 //                                                                                                                                               Document]);  
1688          end;          end;
1689  end;  end;
1690    
# Line 1672  begin Line 1695  begin
1695  end;  end;
1696    
1697  procedure TThreadItem.DeleteLogFile;  procedure TThreadItem.DeleteLogFile;
1698    var
1699            tmpFileName: String;
1700  begin  begin
1701          ParentBoard.BeginUpdate;          ParentBoard.BeginUpdate;
1702    
1703          if FUnRead then          if FUnRead then
1704                  ParentBoard.UnRead := ParentBoard.UnRead - 1;                  ParentBoard.UnRead := ParentBoard.UnRead - 1;
1705          DeleteFile(GetThreadFileName);          DeleteFile(GetThreadFileName);
1706            //試験的にtmpも削除してみる
1707            tmpFileName := StringReplace(GetThreadFileName, 'dat', 'tmp', [rfReplaceAll]);
1708            DeleteFile(tmpFileName);
1709    
1710          if FileExists(ChangeFileExt(GetThreadFileName,'.NG')) = true then          if FileExists(ChangeFileExt(GetThreadFileName,'.NG')) = true then
1711                  DeleteFile(ChangeFileExt(GetThreadFileName,'.NG'));                  DeleteFile(ChangeFileExt(GetThreadFileName,'.NG'));
1712          FRoundDate := ZERO_DATE;          FRoundDate := ZERO_DATE;
# Line 1706  begin Line 1735  begin
1735          if Length( FilePath ) > 0 then          if Length( FilePath ) > 0 then
1736                  Result := FilePath                  Result := FilePath
1737          else          else
1738                  Result := IncludeTrailingPathDelimiter( GikoSys.Setting.LogFolder )                  Result := GikoSys.Setting.LogFolderP
1739                                                  + BBS2CH_LOG_FOLDER + PATH_DELIM + ParentBoard.BBSID + PATH_DELIM + FileName;                                                  + BBS2CH_LOG_FOLDER + PATH_DELIM + ParentBoard.BBSID + PATH_DELIM + FileName;
1740  end;  end;
1741    
# Line 1718  begin Line 1747  begin
1747                  ParentBoard.FModified := True;                  ParentBoard.FModified := True;
1748  end;  end;
1749    
 {procedure TThreadItem.SetRoundNo(i: Integer);  
 begin  
         if FRoundNo = i then Exit;  
         FRoundNo := i;  
         if FUpdate and (ParentBoard <> nil) then  
                 ParentBoard.FModified := True;  
 end;}  
   
1750  procedure TThreadItem.SetRound(b: Boolean);  procedure TThreadItem.SetRound(b: Boolean);
1751  begin  begin
1752          if b then          if b then
# Line 1746  begin Line 1767  begin
1767                  ParentBoard.FModified := True;                  ParentBoard.FModified := True;
1768  end;  end;
1769    
1770    
1771  procedure TThreadItem.SetKokomade(i: Integer);  procedure TThreadItem.SetKokomade(i: Integer);
1772  begin  begin
1773          if FKokomade = i then Exit;          if FKokomade = i then Exit;
# Line 1758  procedure TThreadItem.SetUnRead(b: Boole Line 1780  procedure TThreadItem.SetUnRead(b: Boole
1780  begin  begin
1781          if FUnRead = b then Exit;          if FUnRead = b then Exit;
1782          FUnRead := b;          FUnRead := b;
1783          if FUpdate and (ParentBoard <> nil) then          if FUpdate and (ParentBoard <> nil) then begin
1784                  ParentBoard.FModified := True;                  ParentBoard.FModified := True;
1785                    if FUnRead then begin
1786                            ParentBoard.UnRead := ParentBoard.UnRead + 1;
1787                    end else begin
1788                ParentBoard.UnRead := ParentBoard.UnRead - 1;
1789                    end;
1790            end;
1791  end;  end;
1792    
1793  procedure TThreadItem.SetScrollTop(i: Integer);  procedure TThreadItem.SetScrollTop(i: Integer);
# Line 1780  begin Line 1808  begin
1808          FUpdate := True;          FUpdate := True;
1809  end;  end;
1810    
 {initialization  
         BBS2ch := TBBS.Create;  
   
 finalization  
         if BBS2ch <> nil then  
                 BBS2ch.Free;}  
1811  function TThreadItem.GetCreateDate: TDateTime;  function TThreadItem.GetCreateDate: TDateTime;
 var  
         unixtime: Int64;  
     tmp: string;  
1812  begin  begin
1813          // ファイル名からスレ作成日時を求める          // ファイル名からスレ作成日時を求める
1814          try          try
# Line 1797  begin Line 1816  begin
1816              Result := ZERO_DATE              Result := ZERO_DATE
1817          else begin          else begin
1818              // ログファイルの拡張子をはずしたものがスレ作成日時              // ログファイルの拡張子をはずしたものがスレ作成日時
1819                          tmp := ChangeFileExt(FFileName, '');              Result := GikoSys.GetCreateDateFromName(FFileName);
                         if AnsiPos('_', tmp) <> 0 then  
                                 if AnsiPos('_', tmp) > 9 then  
                                         tmp := Copy(tmp, 1, AnsiPos('_', tmp)-1)  
                                 else  
                                         Delete(tmp, AnsiPos('_', tmp), 1);  
   
                         if ( Length(tmp) = 9) and ( tmp[1] = '0' ) then  
                                 Insert('1', tmp, 1);  
   
                         unixtime := StrToInt64Def(tmp, ZERO_DATE);  
                         Result := UnixToDateTime(unixtime) + OffsetFromUTC;  
1820                          if GikoSys.Setting.FutureThread then begin                          if GikoSys.Setting.FutureThread then begin
1821                          if CompareDateTime(Result, Now) = 1 then                          if CompareDateTime(Result, Now) = 1 then
1822                          Result := ZERO_DATE;                          Result := ZERO_DATE;
# Line 1820  begin Line 1828  begin
1828                          Result := ZERO_DATE;                          Result := ZERO_DATE;
1829          end;          end;
1830  end;  end;
1831    function TThreadItem.GetFilePath: String;
1832    var
1833            path : String;
1834    begin
1835            path := ExtractFilePath(Self.ParentBoard.FilePath) + Self.FileName;
1836        Result := path;
1837    end;
1838    
1839    destructor TBoardGroup.Destroy;
1840    begin
1841            Clear;
1842            inherited;
1843    end;
1844    procedure       TBoardGroup.Clear;
1845    var
1846            i       : Integer;
1847    begin
1848            for i := Self.Count - 1 downto 0 do begin
1849                    try
1850                            TBoard(Self.Objects[i]).Free;
1851                    except
1852                    end;
1853        end;
1854        inherited Clear;
1855            Self.Capacity := 0;
1856            try
1857                    if FBoardPlugIn <> nil then
1858                            FBoardPlugIn.Free;
1859            FBoardPlugIn := nil;
1860            except
1861            end;
1862    
1863    end;
1864    
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;
1878    
1879  end.  end.
1880    

Legend:
Removed from v.1.50.2.1  
changed lines
  Added in v.1.77

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