X-Git-Url: http://git.osdn.net/view?a=blobdiff_plain;f=GikoSystem.pas;h=2c1e4d7d5a4794a97f545d1c3ed8f82f52d7aca3;hb=refs%2Fheads%2FBb62;hp=6e99c3345c0cffb4f923bd0c641ae7f3f197aec2;hpb=ba9b83aa7f28ff95650db9f3b5d752d68148b180;p=gikonavigoeson%2Fgikonavi.git diff --git a/GikoSystem.pas b/GikoSystem.pas index 6e99c33..2c1e4d7 100644 --- a/GikoSystem.pas +++ b/GikoSystem.pas @@ -15,7 +15,7 @@ uses {HttpApp,} URLMon, IdGlobal, IdURI, {Masks,} Setting, BoardGroup, gzip, Dolib, bmRegExp, AbonUnit, ExternalBoardManager, ExternalBoardPlugInMain, - GikoBayesian, GikoMessage; + GikoBayesian, GikoMessage, Belib; type TVerResourceKey = ( @@ -112,6 +112,7 @@ type FBayesian : TGikoBayesian; //!< ƒxƒCƒWƒAƒ“ƒtƒBƒ‹ƒ^ FVersion : String; //!< ƒtƒ@ƒCƒ‹ƒo[ƒWƒ‡ƒ“ FGikoMessage: TGikoMessage; + FBelib: TBelib; //! ‚ ‚éƒZƒpƒŒ[ƒ^‚Å‹æØ‚ç‚ꂽ•¶Žš—ñ‚©‚ç‚Ž”Ô–Ú‚Ì•¶Žš—ñ‚ðŽæ‚èo‚· function ChooseString(const Text, Separator: string; Index: integer): string; //! ˆêŽžƒtƒ@ƒCƒ‹‚©‚ç‚Ì•œ‹Œ @@ -165,6 +166,7 @@ type function DivideSubject(Line: string): TSubjectRec; property Setting: TSetting read FSetting write FSetting; property Dolib: TDolib read FDolib write FDolib; + property Belib: TBelib read FBelib write FBelib; function UrlToID(url: string): string; function UrlToServer(url: string): string; @@ -181,7 +183,7 @@ type procedure MenuFont(Font: TFont); - function RemoveToken(var s:string; const delimiter:string):string; +// function RemoveToken(var s:string; const delimiter:string):string; function GetTokenIndex(s: string; delimiter: string; index: Integer): string; function GetShortName(const LongName: string; ALength: integer): string; @@ -213,13 +215,11 @@ type procedure GetPopupResNumber(URL : string; var stRes, endRes : Int64); property Bayesian : TGikoBayesian read FBayesian write FBayesian; - function GetSameIDResAnchor(const AID : string; ThreadItem: TThreadItem; limited: Integer):string; overload; - function GetSameIDResAnchor(AIDNum : Integer; ThreadItem: TThreadItem; limited: Integer):string; overload; + function CreateResAnchor(var Numbers: TStringList; ThreadItem: TThreadItem; limited: Integer):string; procedure GetSameIDRes(const AID : string; ThreadItem: TThreadItem;var body: TStringList); overload; procedure GetSameIDRes(AIDNum : Integer; ThreadItem: TThreadItem;var body: TStringList); overload; - function GetSameIDResCount(const AID : string; ThreadItem: TThreadItem):Integer; overload; - function GetSameIDResCount(AIDNum : Integer; ThreadItem: TThreadItem):Integer; overload; - + function GetResID(AIDNum: Integer; ThreadItem: TThreadItem): String; + function ExtructResID(ADateStr: String): String; //! ’PŒê‰ðÍ procedure SpamCountWord( const text : string; wordCount : TWordCount ); //! ŠwKƒNƒŠƒA @@ -228,8 +228,6 @@ type procedure SpamLearn( wordCount : TWordCount; isSpam : Boolean ); //! ƒXƒpƒ€“x” function SpamParse( const text : string; wordCount : TWordCount ) : Extended; - //ˆø”‚ªA“ú•t‚Å‚àŽž‚Å‚à‚È‚¢‚±‚Ƃ𒲂ׂé - function NotDateorTimeString(const AStr : string): boolean; //! ˆø”‚É‘—‚ç‚ê‚Ä‚«‚½“ú•t/ID•”‚ÉBE‚Ì•¶Žš—ñ‚ª‚ ‚Á‚½‚çAƒvƒƒtƒ@ƒCƒ‹‚ւ̃Šƒ“ƒN‚ð’ljÁ function AddBeProfileLink(AID : string; ANum: Integer): string; @@ -256,6 +254,19 @@ type procedure AddOutofIndexDat(Board: TBoard; DatList: TStringList; AllCreate: boolean = True); //! ƒtƒ@ƒCƒ‹–¼‚©‚ç‚̃XƒŒƒbƒhì¬“ú‚̎擾 function GetCreateDateFromName(FileName: String): TDateTime; + function GetExtpreviewFileName: String; + + procedure ShowRefCount(msg: String; unk: IUnknown); + //! –`Œ¯‚̏‘CookieŽæ“¾ + function GetBoukenCookie(AURL: String): String; + //! –`Œ¯‚̏‘CookieÝ’è + procedure SetBoukenCookie(ACookieValue, ADomain: String); + //! –`Œ¯‚̏‘Cookieíœ + procedure DelBoukenCookie(ADomain: String); + //! –`Œ¯‚̏‘Domainˆê——Žæ“¾ + procedure GetBoukenDomain(var ADomain: TStringList); + //! –`Œ¯‚̏‘ƒhƒƒCƒ“–¼CookieŽæ“¾ + function GetBouken(AURL: String; var Domain: String): String; end; var @@ -265,7 +276,7 @@ const ZERO_DATE: Integer = 25569; BETA_VERSION_NAME_E = 'beta'; BETA_VERSION_NAME_J = 'ÊÞÀ'; - BETA_VERSION = 57; + BETA_VERSION = 62; BETA_VERSION_BUILD = ''; //!< debug”Å‚È‚Ç APP_NAME = 'gikoNavi'; BE_PHP_URL = 'http://be.2ch.net/test/p.php?i='; @@ -284,6 +295,7 @@ const NGWORDs_DIR_NAME : String = 'NGwords'; READ_PATH: string = '/test/read.cgi/'; + HTML_READ_PATH: string = '/test/read.html/'; OLD_READ_PATH: string = '/test/read.cgi?'; KAKO_PATH: string = '/kako/'; @@ -306,8 +318,10 @@ const // ************************************************************************* constructor TGikoSys.Create; begin + Inherited; FSetting := TSetting.Create; FDolib := TDolib.Create; + FBelib := TBelib.Create; FAWKStr := TAWKStr.Create(nil); if DirectoryExists(GetConfigDir) = false then begin CreateDir(GetConfigDir); @@ -344,18 +358,6 @@ var i: Integer; FileList: TStringList; begin - //ƒXƒŒƒbƒhƒf[ƒ^ƒtƒ@ƒCƒ‹‚ðXV -// FlashExitWrite; - -// FExitWrite.Free; - FBayesian.Free; - FAWKStr.Free; - FSetting.Free; - FDolib.Free; - FAbon.Free; - FSelectResFilter.Free; - FGikoMessage.Free; - //FBoardURLList.Free; //ƒeƒ“ƒ|ƒ‰ƒŠHTML‚ðíœ FileList := TStringList.Create; try @@ -368,6 +370,14 @@ begin finally FileList.Free; end; + FreeAndNil(FGikoMessage); + FreeAndNil(FBayesian); + FreeAndNil(FSelectResFilter); + FreeAndNil(FAbon); + FreeAndNil(FAWKStr); + FreeAndNil(FBelib); + FreeAndNil(FDolib); + FreeAndNil(FSetting); inherited; end; @@ -649,7 +659,7 @@ begin end; end; - ThreadItem.BeginUpdate; + //ThreadItem.BeginUpdate; if (datFileCheck) and (islog) then FileList.Delete( Index ); @@ -674,7 +684,7 @@ begin Node := FavoriteDM.TreeView.Items.AddChildObject( FavoriteDM.TreeView.Items.Item[0], ThreadItem.Title, FavoThreadItem); *} - ThreadItem.EndUpdate; + //ThreadItem.EndUpdate; Board.Add(ThreadItem); if (ThreadItem.UnRead) and (ThreadItem.IsLogFile) then @@ -703,7 +713,7 @@ begin Board.IsThreadDatRead := True; {$IFDEF DEBUG} rt := GetTickCount - st; - Writeln('Read Done.' + IntToStr(rt) + ' ms'); + Writeln('Read Done.' + Board.Title + ':' + IntToStr(rt) + ' ms'); {$ENDIF} end; {! @@ -947,7 +957,7 @@ begin Result.FLastModified := IntToDateTime(StrToIntDef('$' + MojuUtils.RemoveToken(Line, #1), ZERO_DATE)); Result.FKokomade := StrToIntDef('$' + MojuUtils.RemoveToken(Line, #1), -1); Result.FNewReceive := StrToIntDef('$' + MojuUtils.RemoveToken(Line, #1), 0); - RemoveToken(Line, #1);//9: ; //–¢Žg—p + MojuUtils.RemoveToken(Line, #1);//9: ; //–¢Žg—p Result.FUnRead := IntToBool(StrToIntDef('$' + MojuUtils.RemoveToken(Line, #1), 0)); Result.FScrollTop := StrToIntDef('$' + MojuUtils.RemoveToken(Line, #1), 0); Result.FAllResCount := StrToIntDef('$' + MojuUtils.RemoveToken(Line, #1), 0); @@ -1102,8 +1112,8 @@ begin Delim := ',' else Delim := '<>'; - Result.FFileName := RemoveToken(Line, Delim); - Result.FTitle := Trim(RemoveToken(Line, Delim)); + Result.FFileName := MojuUtils.RemoveToken(Line, Delim); + Result.FTitle := Trim(MojuUtils.RemoveToken(Line, Delim)); ws := Result.FTitle; if Copy(ws, Length(ws), 1) = ')' then begin @@ -1190,10 +1200,10 @@ end; } function TGikoSys.DirectoryExistsEx(const Name: string): Boolean; var - Code: Integer; + Code: Cardinal; begin Code := GetFileAttributes(PChar(Name)); - Result := (Code <> -1) and (FILE_ATTRIBUTE_DIRECTORY and Code <> 0); + Result := (Code <> Cardinal(-1)) and (FILE_ATTRIBUTE_DIRECTORY and Code <> 0); end; {! @@ -1348,17 +1358,15 @@ var nm: NONCLIENTMETRICS; begin nm.cbSize := sizeof(NONCLIENTMETRICS); - - SystemParametersInfo(SPI_GETNONCLIENTMETRICS, 0, @nm, 0); - lf := nm.lfMenuFont; - - Font.Name := lf.lfFaceName; - Font.Height := lf.lfHeight; - Font.Style := []; - if lf.lfWeight >= 700 then - Font.Style := Font.Style + [fsBold]; - if lf.lfItalic = 1 then - Font.Style := Font.Style + [fsItalic]; + SystemParametersInfo(SPI_GETNONCLIENTMETRICS, 0, @nm, 0); + lf := nm.lfMenuFont; + Font.Name := lf.lfFaceName; + Font.Height := lf.lfHeight; + Font.Style := []; + if lf.lfWeight >= 700 then + Font.Style := Font.Style + [fsBold]; + if lf.lfItalic = 1 then + Font.Style := Font.Style + [fsItalic]; end; {! @@ -1369,7 +1377,7 @@ end; ‚Ç‚±‚©‚̃TƒCƒg‚©‚ç‚̃pƒNƒŠ } -function TGikoSys.RemoveToken(var s: string;const delimiter: string): string; +{function TGikoSys.RemoveToken(var s: string;const delimiter: string): string; var p: Integer; begin @@ -1380,7 +1388,7 @@ begin Result := Copy(s, 1, p - 1); Delete(s, 1, Length(Result) + Length(delimiter)); end; - +} {! \brief n ŒÂ–ڂ̃g[ƒNƒ“‚ðØ‚èo‚µ @@ -1396,7 +1404,7 @@ var begin Result := ''; for i := 0 to index do - Result := RemoveToken(s, delimiter); + Result := MojuUtils.RemoveToken(s, delimiter); end; @@ -1638,7 +1646,7 @@ begin SI.cbReserved2 := 0; SI.lpReserved2 := nil; SI.dwysize := 0; - Windows.CreateProcess(nil, + if Windows.CreateProcess(nil, PChar(Path), nil, nil, @@ -1647,7 +1655,11 @@ begin nil, nil, SI, - PI); + PI) then + begin + CloseHandle(PI.hProcess); + end; + end; {! @@ -1656,14 +1668,45 @@ end; \param BrowserType ƒuƒ‰ƒEƒU‚̃^ƒCƒv(IE ‚©‚Ç‚¤‚©) } procedure TGikoSys.OpenBrowser(URL: string; BrowserType: TGikoBrowserType); +var + i, j : Integer; + path, arg : String; + params : TStringList; begin case BrowserType of gbtIE: HlinkNavigateString(nil, PWideChar(WideString(URL))); gbtUserApp, gbtAuto: - if (Setting.URLApp) and (FileExists(Setting.URLAppFile)) then - GikoSys.CreateProcess(Setting.URLAppFile, URL) - else + if (Setting.URLApp) then begin + if (FileExists(Setting.URLAppFile)) then begin + GikoSys.CreateProcess(Setting.URLAppFile, URL) + end else begin + // ‹N“®ƒpƒ‰ƒ[ƒ^•t‚«‘΍ô + path := ''; + params := TStringList.Create; + try + params.Delimiter := ' '; + params.DelimitedText := Setting.URLAppFile; + for i := 0 to params.Count - 1 do begin + path := TrimLeft(path + ' ' + params[i]); + if (FileExists(path)) then begin + arg := ''; + for j := i + 1 to params.Count - 1 do begin + arg := arg + ' ' + params[j]; + end; + break; + end; + end; + if i < params.Count then begin + GikoSys.CreateProcess(path, arg + ' ' + URL); + end else begin + HlinkNavigateString(nil, PWideChar(WideString(URL))); + end; + finally + params.Free; + end; + end; + end else HlinkNavigateString(nil, PWideChar(WideString(URL))); end; end; @@ -1841,7 +1884,13 @@ begin Index := AnsiPos(READ_PATH, path); if Index <> 0 then begin s := Copy(path, Index + Length(READ_PATH), Length(path)); - + end else begin + Index := AnsiPos(HTML_READ_PATH, path); + if Index <> 0 then begin + s := Copy(path, Index + Length(HTML_READ_PATH), Length(path)); + end; + end; + if Index <> 0 then begin if (Length(s) > 0) and (s[1] = '/') then Delete(s, 1, 1); BBSID := GetTokenIndex(s, '/', 0); @@ -1891,84 +1940,93 @@ http://2ch.net/ ‚̏ꍇ stRef = 32, endRes = 50 ‚É‚È‚é } procedure TGikoSys.GetPopupResNumber(URL : string; var stRes, endRes : Int64); +const + START_NAME : array[0..1] of String = ('st=', 'start='); + END_NAME : array[0..1] of String = ('to=', 'end='); + RES_NAME : array[0..0] of String = ('res='); var buf : String; convBuf : String; ps : Int64; pch : PChar; + bufList : TStringList; + i, j, idx : Integer; begin URL := Trim(LowerCase(URL)); - if (AnsiPos('&st=', URL ) <> 0) and ( AnsiPos( '&to=',URL) <> 0 ) then begin - stRes := 0; - endRes := 0; - try - buf := Copy( URL, AnsiPos('&st=', URL ) + 4, AnsiPos( '&to=',URL) - AnsiPos('&st=', URL ) - 4 ); - if buf <> '' then - stRes := StrToInt64( buf ); - if AnsiPos( '&nofirst=',URL) <> 0 then begin - buf := Copy( URL, AnsiPos('&to=', URL ) + 4, AnsiPos( '&nofirst=',URL) - AnsiPos('&to=', URL ) - 4); - end else begin - buf := Copy( URL, AnsiPos('&to=', URL ) + 4, Length( URL ) - AnsiPos('&to=', URL ) - 4 + 1 ); - ps := 0; - pch := PChar(buf); - while ( ps < Length(buf) )and ( pch[ps] >= '0' ) and ( pch[ps] <= '9' ) do Inc(ps); - buf := Copy( buf, 1, ps ); - end; - try - if buf <> '' then - endRes := StrToInt64(buf) - except - endRes := 0; - end; - except - stRes := 0; - end; - if (stRes <> 0) and (endRes = 0) then - endRes := stRes + MAX_POPUP_RES - else if (stRes = 0) and (endRes <> 0) then begin - stRes := endRes - MAX_POPUP_RES; - if stRes < 1 then - stRes := 1; - end; - GikoSys.GetBrowsableThreadURL( URL ); - end else if( AnsiPos('&res=', URL ) <> 0 ) then begin - endRes := 0; - buf := Copy( URL, AnsiPos('&res=', URL ) + 5, Length( URL ) - AnsiPos('&res=', URL ) - 5 + 1 ); - ps := 0; - pch := PChar(buf); - while ( ps < Length(buf) )and ( pch[ps] >= '0' ) and ( pch[ps] <= '9' ) do Inc(ps); - buf := Copy( buf, 1, ps ); - try - if buf <> '' then - stRes := StrToInt(buf) - else begin - stRes := 0; - end; - except - stRes := 0; - end; - end else if (AnsiPos('&start=', URL ) <> 0) and ( AnsiPos( '&end=',URL) <> 0 ) then begin - try - stRes := StrToInt64( Copy( URL, AnsiPos('&start=', URL ) + 7, AnsiPos( '&end=',URL) - AnsiPos('&start=', URL ) - 7 ) ); - if AnsiPos( '&nofirst=',URL) <> 0 then begin - buf := Copy( URL, AnsiPos('&end=', URL ) + 5, AnsiPos( '&nofirst=',URL) - AnsiPos('&end=', URL ) - 5); - end else begin - buf := Copy( URL, AnsiPos('&end=', URL ) + 5, Length( URL ) - AnsiPos('&to=', URL ) - 5 + 1 ); - ps := 0; - pch := PChar(buf); - while ( ps < Length(buf) )and ( pch[ps] >= '0' ) and ( pch[ps] <= '9' ) do Inc(ps); - buf := Copy( buf, 1, ps ); - end; - try - if buf <> '' then - endRes := StrToInt64(buf); - except - endRes := 0; - end; - except - stRes := 0; - end; - end else if ( AnsiPos('.html',URL) <> Length(URL) -4 ) and ( AnsiPos('.htm',URL) <> Length(URL) -3 ) then begin + for i := 0 to Length(START_NAME) -1 do begin + idx := AnsiPos(START_NAME[i], URL); + if (idx <> 0) then begin + break; + end; + idx := AnsiPos(END_NAME[i], URL); + if (idx <> 0) then begin + break; + end; + + end; + + if (idx <> 0) then begin + idx := AnsiPos('?', URL); + if (idx = 0) then begin + idx := LastDelimiter('/', URL); + end; + stRes := 0; + endRes := 0; + bufList := TStringList.Create(); + try + bufList.Delimiter := '&'; + bufList.DelimitedText := Copy(URL, idx + 1, Length(URL)); + for i := 0 to bufList.Count - 1 do begin + convBuf := ''; + // ŠJŽnƒŒƒX”Ô‚ÌŒŸõ + if (stRes = 0) then begin + for j := 0 to Length(START_NAME) - 1 do begin + idx := AnsiPos(START_NAME[j], bufList[i]); + if (idx = 1) then begin + convBuf := Copy(bufList[i], idx + Length(START_NAME[j]), Length(bufList[i])); + stRes := StrToInt64Def( convBuf, 0 ); + break; + end; + end; + end; + // I—¹ƒŒƒX”Ô‚ÌŒŸõ + if (convBuf = '') and (endRes = 0) then begin + for j := 0 to Length(END_NAME) - 1 do begin + idx := AnsiPos(END_NAME[j], bufList[i]); + if (idx = 1) then begin + convBuf := Copy(bufList[i], idx + Length(END_NAME[j]), Length(bufList[i])); + endRes := StrToInt64Def( convBuf, 0 ); + break; + end; + end; + end; + // ƒŒƒX”Ô‚ÌŒŸõ + if ((stRes = 0) and (endRes = 0) and (convBuf = '')) then begin + for j := 0 to Length(RES_NAME) - 1 do begin + idx := AnsiPos(RES_NAME[j], bufList[i]); + if (idx = 1) then begin + convBuf := Copy(bufList[i], idx + Length(RES_NAME[j]), Length(bufList[i])); + stRes := StrToInt64Def( convBuf, 0 ); + endRes := stRes; + break; + end; + end; + end; + end; + + if (stRes <> 0) and (endRes = 0) then begin + endRes := stRes + MAX_POPUP_RES; + end else if (stRes = 0) and (endRes <> 0) then begin + stRes := endRes - MAX_POPUP_RES; + if stRes < 1 then begin + stRes := 1; + end; + end; + finally + bufList.clear; + bufList.free; + end; + end else if ( AnsiPos('.html',URL) <> Length(URL) -4 ) and ( AnsiPos('.htm',URL) <> Length(URL) -3 ) then begin buf := Copy(URL, LastDelimiter('/',URL)+1,Length(URL)-LastDelimiter('/',URL)+1); if Length(buf) > 0 then begin if AnsiPos('-', buf) = 1 then begin @@ -1977,15 +2035,10 @@ begin ps := 0; pch := PChar(buf); while ( ps < Length(buf) )and ( pch[ps] >= '0' ) and ( pch[ps] <= '9' ) do Inc(ps); - try - convBuf := Copy( buf, 1, ps ); - if convBuf <> '' then - endRes := StrToInt64(convBuf) - else - endRes := 0; - except - endRes := 0; - end; + convBuf := Copy( buf, 1, ps ); + if convBuf <> '' then begin + endRes := StrToInt64Def(convBuf, 0); + end; if endRes <> 0 then begin stRes := endRes - MAX_POPUP_RES; if stRes < 1 then @@ -2003,15 +2056,10 @@ begin ps := 0; pch := PChar(buf); while ( ps < Length(buf) )and ( pch[ps] >= '0' ) and ( pch[ps] <= '9' ) do Inc(ps); - try - convBuf := Copy( buf, 1, ps ); - if convBuf <> '' then - endRes := StrToInt64(convBuf) - else - endRes := 0; - except - endRes := 0; - end; + convBuf := Copy( buf, 1, ps ); + if convBuf <> '' then begin + endRes := StrToInt64Def(convBuf, 0); + end; end else begin stRes := 0; end; @@ -2021,9 +2069,6 @@ begin end; end; end; - end else begin - //stRes := 0; - //endRes := 0; end; end; @@ -2070,7 +2115,7 @@ begin //•W€‘Ž® //ÅŒã‚Íl50, 10, 10-20, 10n, 10-20n, -10, 10-, 10n- ‚È‚Ç //http://xxx.2ch.net/test/read.cgi/bbsid/1000000000/ - FAWKStr.RegExp := '/test/read.cgi/.+/[0-9]+/?.*'; + FAWKStr.RegExp := '/test/read.(cgi|html)/.+/[0-9]+/?.*'; if FAWKStr.Match(FAWKStr.ProcessEscSeq(s), RStart, RLength) > 0 then begin s := Copy(s, 15, Length(s)); @@ -2508,6 +2553,7 @@ procedure TGikoSys.ListBoardFile; var boardFileList : TStringList; i, l : Integer; + sCategory : TCategory; begin // BBS ‚ÌŠJ•ú try @@ -2550,6 +2596,20 @@ begin BoardFileList.Free; end; end; + + // “ÁŽê—p“rBBS¶¬ + // Šù‚É‘¶Ý‚·‚éê‡‚͍폜‚·‚é + DestorySpecialBBS(BoardGroup.SpecialBBS); + SpecialBBS := TBBS.Create(''); + SpecialBBS.Title := '“ÁŽê—p“r(”ñ•\Ž¦)'; + sCategory := TCategory.Create; + sCategory.No := 1; + sCategory.Title := '“ÁŽê—p“r(”ñ•\Ž¦)'; + SpecialBBS.Add(sCategory); + BoardGroup.SpecialBoard := TSpecialBoard.Create(nil, 'http://localhost/gikonavi/special/index.html'); + BoardGroup.SpecialBoard.Title := 'ƒ^ƒuˆê——'; + BoardGroup.SpecialBoard.IsThreadDatRead := True; + sCategory.Add(BoardGroup.SpecialBoard); end; {! @@ -2747,20 +2807,18 @@ function TGikoSys.GetSambaFileName : string; begin Result := Setting.GetSambaFileName; end; - {! -\brief “¯‚¶“Še ID ‚ðŽ‚ÂƒŒƒX‚ðƒAƒ“ƒJ[‚É‚µ‚Ä—ñ‹“ -\param AID ŒÂl‚ð“Á’è‚·‚é“Še ID +\brief —ñ‹“‚³‚ꂽƒŒƒX”ԍ†‚ւ̃Aƒ“ƒJ[—pHTMLì¬ +\param Numbers —ñ‹“‚³‚ꂽƒŒƒX”ԍ† \param ThreadItem —ñ‹“‚·‚éƒXƒŒƒbƒh \param limited —ñ‹“‚·‚鐔‚𐧌À‚·‚é‚È‚ç1ˆÈã \return —ñ‹“‚³‚ꂽƒŒƒXƒAƒ“ƒJ[ } -function TGikoSys.GetSameIDResAnchor( - const AID : string; ThreadItem: TThreadItem; +function TGikoSys.CreateResAnchor( + var Numbers: TStringList; ThreadItem: TThreadItem; limited: Integer):string; var i: integer; - body: TStringList; Res: TResRec; ResLink : TResLinkRec; begin @@ -2768,29 +2826,22 @@ begin Res.FBody := ''; Res.FType := glt2chNew; - Result := ''; - if (not IsNoValidID(AID)) and - (ThreadItem <> nil) and (ThreadItem.IsLogFile) then begin - body := TStringList.Create; - try - GetSameIDRes(AID, ThreadItem, body); - if (limited > 0) and (body.Count > limited) then begin - for i := body.Count - limited to body.Count - 1 do begin - Res.FBody := Res.FBody + '>' + body[i] + ' '; - end; - end else begin - for i := 0 to body.Count - 1 do begin - Res.FBody := Res.FBody + '>' + body[i] + ' '; - end; - end; - finally - body.Free; - end; + Result := ''; + if (Numbers <> nil) and (Numbers.Count > 0) then begin + if (limited > 0) and (Numbers.Count > limited) then begin + for i := Numbers.Count - limited to Numbers.Count - 1 do begin + Res.FBody := Res.FBody + '>' + Numbers[i] + ' '; + end; + end else begin + for i := 0 to Numbers.Count - 1 do begin + Res.FBody := Res.FBody + '>' + Numbers[i] + ' '; + end; + end; ResLink.FBbs := ThreadItem.ParentBoard.BBSID; ResLink.FKey := ChangeFileExt(ThreadItem.FileName, ''); HTMLCreater.ConvRes(@Res, @ResLink, false); Result := Res.FBody; - end; + end; end; {! @@ -2805,6 +2856,22 @@ var ReadList: TStringList; Res: TResRec; boardPlugIn : TBoardPlugIn; + + procedure CheckSameID(const AID:String; const Target: String; no: Integer); + var + pos: Integer; + begin + pos := AnsiPos('id:', LowerCase(Target)); + if (pos > 0) then begin + if(AnsiPos(AID, Copy(Target, pos-1, Length(Target))) > 0) then begin + body.Add(IntToStr(no)); + end; + end else begin + if(AnsiPos(AID, Target) > 0) then begin + body.Add(IntToStr(no)); + end; + end; + end; begin if (not IsNoValidID(AID)) and (ThreadItem <> nil) and (ThreadItem.IsLogFile) then begin @@ -2817,9 +2884,7 @@ begin for i := 0 to threadItem.Count - 1 do begin // ƒŒƒX THTMLCreate.DivideStrLine(boardPlugIn.GetDat(DWORD( threadItem ), i + 1), @Res); - if(AnsiPos(AID, Res.FDateTime) > 0) then begin - body.Add(IntToStr(i+1)); - end; + CheckSameID(AID, Res.FDateTime, i+1); end; end else begin ReadList := TStringList.Create; @@ -2827,9 +2892,7 @@ begin ReadList.LoadFromFile(ThreadItem.GetThreadFileName); for i := 0 to ReadList.Count - 1 do begin THTMLCreate.DivideStrLine(ReadList[i], @Res); - if AnsiPos(AID, Res.FDateTime) > 0 then begin - body.Add(IntToStr(i+1)); - end; + CheckSameID(AID, Res.FDateTime, i+1); end; finally ReadList.Free; @@ -2842,60 +2905,29 @@ end; \brief “¯‚¶“Še ID ‚ðŽ‚ÂƒŒƒX‚ð—ñ‹“ \param AIDNum ŒÂl‚ð“Á’è‚·‚é“Še ID \param ThreadItem —ñ‹“‚·‚éƒXƒŒƒbƒh -\param limited —ñ‹“‚·‚鐔‚𐧌À‚·‚é‚È‚ç1ˆÈã -\return +\param body OUT:—ñ‹“‚³‚ꂽƒŒƒX”ԍ†‚ª•Ô‚é } -function TGikoSys.GetSameIDResAnchor(AIDNum : Integer; - ThreadItem: TThreadItem; - limited: Integer):string; +procedure TGikoSys.GetSameIDRes(AIDNum : Integer; ThreadItem: TThreadItem;var body: TStringList); var - i: integer; - body: TStringList; - Res: TResRec; - ResLink : TResLinkRec; + AID : String; begin - // bodyˆÈŠO‚ÍŽg—p‚µ‚È‚¢‚̂ŏ‰Šú‰»‚µ‚È‚¢ - Res.FBody := ''; - Res.FType := glt2chNew; - - Result := ''; - if (ThreadItem <> nil) and (ThreadItem.IsLogFile) then begin - body := TStringList.Create; - try - GetSameIDRes(AIDNum, ThreadItem, body); - if (limited > 0) and ( body.Count > limited) then begin - for i := body.Count - 20 to body.Count - 1 do begin - Res.FBody := Res.FBody + '>' + body[i] + ' '; - end; - end else begin - for i := 0 to body.Count - 1 do begin - Res.FBody := Res.FBody + '>' + body[i] + ' '; - end; - end; - finally - body.Free; - end; - ResLink.FBbs := ThreadItem.ParentBoard.BBSID; - ResLink.FKey := ChangeFileExt(ThreadItem.FileName, ''); - HTMLCreater.ConvRes(@Res, @ResLink, false); - Result := Res.FBody; + AID := GetResID(AIDNum, ThreadItem); + if not IsNoValidID(AID) then begin + GetSameIDRes(AID, ThreadItem, body); end; end; - {! -\brief “¯‚¶“Še ID ‚ðŽ‚ÂƒŒƒX‚ð—ñ‹“ -\param AIDNum ŒÂl‚ð“Á’è‚·‚é“Še ID -\param ThreadItem —ñ‹“‚·‚éƒXƒŒƒbƒh -\param body OUT:—ñ‹“‚³‚ꂽƒŒƒX”ԍ†‚ª•Ô‚é +\brief “Še ID Žæ“¾ +\param AIDNum “Še ƒŒƒX”ԍ† +\param ThreadItem “ŠeƒXƒŒƒbƒh +\param body OUT:“ŠeID } -procedure TGikoSys.GetSameIDRes(AIDNum : Integer; ThreadItem: TThreadItem;var body: TStringList); +function TGikoSys.GetResID(AIDNum: Integer; ThreadItem: TThreadItem): String; var Res: TResRec; boardPlugIn : TBoardPlugIn; - AID : String; - stList: TStringList; - i : Integer; begin + Result := ''; if (ThreadItem <> nil) and (ThreadItem.IsLogFile) and (AIDNum > 0) and (AIDNum <= ThreadItem.Count) then begin //if ThreadItem.IsBoardPlugInAvailable then begin @@ -2907,99 +2939,40 @@ begin end else begin THTMLCreate.DivideStrLine( ReadThreadFile(ThreadItem.GetThreadFileName, AIDNum), @Res); end; - AID := Res.FDateTime; - if AnsiPos('id', AnsiLowerCase(AID)) > 0 then begin - AID := Copy(AID, AnsiPos('id', AnsiLowerCase(AID)) - 1, 11); - if AnsiPos(' be:', AnsiLowerCase(AID)) > 0 then begin - AID := Copy(AID, 1, AnsiPos(' BE:', AnsiLowerCase(AID)) - 1) - end; - end else begin - stlist := TStringList.Create; - try - stList.DelimitedText := AID; - AID := ''; - for i := 0 to stList.Count - 1 do - if Length(WideString(stList[i])) = 8 then begin - if NotDateorTimeString(stList[i]) then begin - AID := stList[i]; - break; - end; - end; - finally - stList.Free; - end; - end; - if not IsNoValidID(AID) then - GetSameIDRes(AID, ThreadItem, body); - end; -end; - -{! -\brief “¯‚¶“Še ID ‚ðŽ‚ÂƒŒƒX‚ðƒJƒEƒ“ƒg -\param AID ŒÂl‚ð“Á’è‚·‚é“Še ID -\param ThreadItem —ñ‹“‚·‚éƒXƒŒƒbƒh -\return “¯‚¶ ID ‚ðŽ‚ÂƒŒƒX‚̐” -} -function TGikoSys.GetSameIDResCount(const AID : string; ThreadItem: TThreadItem):Integer; -var - body: TStringList; -begin - Result := 0; - if (not IsNoValidID(AID)) - and (ThreadItem <> nil) and (ThreadItem.IsLogFile) then begin - body := TStringList.Create; - try - GetSameIDRes(AID, ThreadItem, body); - Result := body.Count; - finally - body.Free; - end; + Result := ExtructResID(Res.FDateTime); end; - end; - {! -\brief “¯‚¶“Še ID ‚ðŽ‚ÂƒŒƒX‚ðƒJƒEƒ“ƒg -\param AIDNum ŒÂl‚ð“Á’è‚·‚é“Še ID -\param ThreadItem —ñ‹“‚·‚éƒXƒŒƒbƒh -\return “¯‚¶ ID ‚ðŽ‚ÂƒŒƒX‚̐” +\brief ƒŒƒX‚ÌŽž•”‚©‚çID‚𒊏o‚·‚é +\param ADateStr Žž•”‚Ì•¶Žš—ñ +\return ID(ID‚Æ‚Ý‚È‚¹‚é•”•ª‚ª‚È‚¢‚Æ‚«‚͋󕶎š—ñ) } -function TGikoSys.GetSameIDResCount(AIDNum : Integer; ThreadItem: TThreadItem):Integer; +function TGikoSys.ExtructResID(ADateStr: String): String; var - body: TStringList; -begin - Result := 0; - if (ThreadItem <> nil) and (ThreadItem.IsLogFile) then begin - body := TStringList.Create; - try - GetSameIDRes(AIDNum, ThreadItem, body); - Result := body.Count; - finally - body.Free; - end; - end; -end; - -{! -\brief Žž‚ðŽ¦‚·•¶Žš—ñ‚Å‚Í–³‚¢‚©‚Ç‚¤‚© -\param AStr ’²‚ׂ镶Žš—ñ -\return Žž‚Å‚Í–³‚¢‚È‚ç True -\todo ”Û’èŒ`(Not)‚æ‚èm’èŒn(Is) -} -function TGikoSys.NotDateorTimeString(const AStr : string): boolean; + stlist : TStringList; begin - Result := false; - try - StrToDate(AStr); - except - try - StrToTime(AStr); - Result := false; - except - Result := true; - end; - end; - + Result := ''; + if AnsiPos('id', AnsiLowerCase(ADateStr)) > 0 then begin + Result := Copy(ADateStr, AnsiPos('id', AnsiLowerCase(ADateStr)), Length(ADateStr)); + if AnsiPos(' ', Result) > 0 then begin + Result := Copy(Result, 1, AnsiPos(' ', Result) - 1); + end; + Result := ' ' + Result; + end else begin + stlist := TStringList.Create; + try + stList.Delimiter := ' '; + stList.DelimitedText := ADateStr; + // “ú•t Žž ID ‘¼@‚ƌŒè‚ōl‚¦‚é + if (stList.Count >= 3) then begin + if Length(stList[3 - 1]) >= 7 then begin + Result := stList[3 - 1]; + end; + end; + finally + stList.Free; + end; + end; end; {! @@ -3441,6 +3414,12 @@ function TGikoSys.GetReplaceFileName: String; begin Result := Setting.GetReplaceFileName; end; +//! ƒvƒŒƒrƒ…[Šg’£‚̐ݒèƒtƒ@ƒCƒ‹Žæ“¾ +function TGikoSys.GetExtpreviewFileName: String; +begin + Result := Setting.GetExtprevieFileName; +end; + //! ƒtƒ@ƒCƒ‹–¼‚©‚ç‚̃XƒŒƒbƒhì¬“ú‚̎擾 function TGikoSys.GetCreateDateFromName(FileName: String): TDateTime; var @@ -3462,12 +3441,83 @@ begin Result := UnixToDateTime(unixtime) + OffsetFromUTC; end; +procedure TGikoSys.ShowRefCount(msg: String; unk: IUnknown); +{$IFDEF DEBUG} +var + count : integer; +{$ENDIF} +begin + if not Assigned(unk) then + Exit; + +{$IFDEF DEBUG} + try + unk._AddRef; + count := unk._Release; + + Writeln(msg + ' RefCount=' + IntToStr(count)); + except + Writeln(msg + ' RefCount=exception!!'); + end; +{$ENDIF} +end; +function TGikoSys.GetBoukenCookie(AURL: String): String; +var + Protocol, Host, Path, Document, Port,Bookmark : String; +begin + Result := ''; + GikoSys.ParseURI(AURL, Protocol, Host, Path, Document, Port,Bookmark); + if ( Length(Host) > 0 ) then begin + Result := Setting.GetBoukenCookie(Host); + end; +end; +procedure TGikoSys.SetBoukenCookie(ACookieValue, ADomain: String); +begin + if ( Length(ADomain) > 0 ) then begin + Setting.SetBoukenCookie(ACookieValue, ADomain); + end; +end; +//! –`Œ¯‚̏‘Domainˆê——Žæ“¾ +procedure TGikoSys.GetBoukenDomain(var ADomain: TStringList); +var + i : Integer; +begin + ADomain.Clear; + for i := 0 to Setting.BoukenCookieList.Count - 1 do begin + ADomain.Add( Setting.BoukenCookieList.Names[i] ); + end; +end; +//! –`Œ¯‚̏‘Cookieíœ +procedure TGikoSys.DelBoukenCookie(ADomain: String); +var + i : Integer; +begin + for i := 0 to Setting.BoukenCookieList.Count - 1 do begin + if ( Setting.BoukenCookieList.Names[i] = ADomain ) then begin + Setting.BoukenCookieList.Delete(i); + Break; + end; + end; +end; +function TGikoSys.GetBouken(AURL: String; var Domain: String): String; +var + Protocol, Host, Path, Document, Port,Bookmark : String; + Cookie : String; +begin + Domain := ''; + Cookie := ''; + GikoSys.ParseURI(AURL, Protocol, Host, Path, Document, Port,Bookmark); + if ( Length(Host) > 0 ) then begin + Setting.GetBouken(Host, Domain, Cookie); + Result := Cookie; + end; +end; + initialization GikoSys := TGikoSys.Create; finalization if GikoSys <> nil then begin - GikoSys.Free; - GikoSys := nil; + FreeAndNil(GikoSys); end; end.