Develop and Download Open Source Software

Browse CVS Repository

Contents of /gikonavigoeson/gikonavi/GikoSystem.pas

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


Revision 1.241 - (show annotations) (download) (as text)
Sun Apr 13 04:20:24 2008 UTC (16 years ago) by eggcake
Branch: MAIN
Changes since 1.240: +21 -0 lines
File MIME type: text/x-pascal
TWebBrowserの参照カウントが正しくなるように修正

1 unit GikoSystem;
2
3 interface
4
5 uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
7 ComCtrls, {IniFiles,} ShellAPI, ActnList, Math,
8 {$IF Defined(DELPRO) }
9 SHDocVw,
10 MSHTML,
11 {$ELSE}
12 SHDocVw_TLB,
13 MSHTML_TLB,
14 {$IFEND}
15 {HttpApp,} URLMon, IdGlobal, IdURI, {Masks,}
16 Setting, BoardGroup, gzip, Dolib, bmRegExp, AbonUnit,
17 ExternalBoardManager, ExternalBoardPlugInMain,
18 GikoBayesian, GikoMessage;
19
20 type
21 TVerResourceKey = (
22 vrComments, //!< ?潟?<?潟??
23 vrCompanyName, //!< 篌?腓上??
24 vrFileDescription, //!< 茯???/span>
25 vrFileVersion, //!< ???<?ゃ?????若?吾?с??/span>
26 vrInternalName, //!< ??????
27 vrLegalCopyright, //!< ??篏?罔?/span>
28 vrLegalTrademarks, //!< ??罔?
29 vrOriginalFilename, //!< 罩e????<?ゃ????
30 vrPrivateBuild, //!< ?????ゃ???若????????????/span>
31 vrProductName, //!< 茖遵????
32 vrProductVersion, //!< 茖遵?????若?吾?с??/span>
33 vrSpecialBuild); //!< ?鴻???激?c????????????/span>
34
35 //! BBS?帥?ゃ??
36 TGikoBBSType = (gbt2ch);
37 //! ???違?帥?ゃ??
38 TGikoLogType = (glt2chNew, glt2chOld);
39 //! ?<???祉?若?吾?≪?ゃ?潟??/span>
40 TGikoMessageIcon = (gmiOK, gmiSAD, gmiNG, gmiWhat, gmiNone);
41 //! URL???若???潟???????吟?帥?ゃ??
42 TGikoBrowserType = (gbtIE, gbtUserApp, gbtAuto);
43
44
45 TStrTokSeparator = set of Char;
46 TStrTokRec = record
47 Str: string;
48 Pos: Integer;
49 end;
50
51 //! ?ゃ?潟???????鴻???<?ゃ?????潟?若??
52 TIndexRec = record
53 FNo: Integer;
54 FFileName: string;
55 FTitle: string;
56 FCount: Integer;
57 FSize: Integer;
58 // FRoundNo: Integer;
59 FRoundDate: TDateTime;
60 FLastModified: TDateTime;
61 FKokomade: Integer;
62 FNewReceive: Integer;
63 FMishiyou: Boolean; //!< ??戎??/span>
64 FUnRead: Boolean;
65 FScrollTop: Integer;
66 //Index Ver 1.01
67 FAllResCount: Integer;
68 FNewResCount: Integer;
69 FAgeSage: TGikoAgeSage;
70 end;
71
72 //! ?泣???吾?с???????潟?若??
73 TSubjectRec = record
74 FFileName: string;
75 FTitle: string;
76 FCount: Integer;
77 end;
78
79 //! ???鴻???潟?若???吾?????ゃ?潟??/span>
80 PResRec = ^TResRec;
81
82 //! ???鴻???潟?若??
83 TResRec = record
84 FTitle: string;
85 FMailTo: string;
86 FName: string;
87 FDateTime: string;
88 FBody: string;
89 FType: TGikoLogType;
90 end;
91
92 //! URLPath???潟?若??
93 TPathRec = record
94 FBBS: string; //!< BBSID
95 FKey: string; //!< ThreadID
96 FSt: Int64; //!< ??紮????合??/span>
97 FTo: Int64; //!< 腟?篋????合??/span>
98 FFirst: Boolean; //!< >>1??;腓?/span>
99 FStBegin: Boolean; //!< 1??茵?ず
100 FToEnd: Boolean; //!< ????緇??障?ц;腓?/span>
101 FDone: Boolean; //!< ????
102 FNoParam: Boolean; //!< ???合???????<?若?帥????
103 end;
104
105 TGikoSys = class(TObject)
106 private
107 { Private 絎h? }
108 FSetting: TSetting;
109 FDolib: TDolib;
110 FAWKStr: TAWKStr;
111 FResRange : Longint;
112 FBayesian : TGikoBayesian; //!< ???ゃ?吾?≪?潟???c????/span>
113 FVersion : String; //!< ???<?ゃ?????若?吾?с??/span>
114 FGikoMessage: TGikoMessage;
115 //! ?????祉?????若?帥?у?阪??????????絖???????鐔?????????絖??????????冴??
116 function ChooseString(const Text, Separator: string; Index: integer): string;
117 //! 筝??????<?ゃ????????奨??/span>
118 procedure RestoreThreadData(Board: TBoard);
119 public
120 { Public 絎h? }
121 FAbon : TAbon;
122 FSelectResFilter : TAbon;
123 //FBoardURLList: TStringList;
124 constructor Create;
125
126 destructor Destroy; override;
127 property ResRange : Longint read FResRange write FResRange;
128 //! ???若?吾?с?恰????/span>
129 property Version : String read FVersion;
130 function IsNumeric(s: string): boolean;
131 function IsFloat(s: string): boolean;
132 function DirectoryExistsEx(const Name: string): Boolean;
133 function ForceDirectoriesEx(Dir: string): Boolean;
134
135 function GetBoardFileName: string;
136 function GetCustomBoardFileName: string;
137 function GetHtmlTempFileName: string;
138 function GetAppDir: string;
139 function GetTempFolder: string;
140 function GetSentFileName: string;
141 function GetConfigDir: string;
142 function GetSkinDir: string;
143 function GetSkinHeaderFileName: string;
144 function GetSkinFooterFileName: string;
145 function GetSkinResFileName: string;
146 function GetSkinNewResFileName: string;
147 function GetSkinBookmarkFileName: string;
148 function GetSkinNewmarkFileName: string;
149 function GetStyleSheetDir: string;
150 function GetOutBoxFileName: string;
151 function GetUserAgent: string;
152 function GetSambaFileName : string;
153
154 function GetMainKeyFileName : String;
155 function GetEditorKeyFileName: String;
156 function GetInputAssistFileName: String;
157 procedure ReadSubjectFile(Board: TBoard);
158 procedure CreateThreadDat(Board: TBoard);
159 procedure WriteThreadDat(Board: TBoard);
160 function ParseIndexLine(Line: string): TIndexRec;
161 procedure GetFileList(Path: string; Mask: string; var List: TStringList; SubDir: Boolean; IsPathAdd: Boolean); overload;
162 procedure GetFileList(Path: string; Mask: string; var List: TStringList; IsPathAdd: Boolean); overload;//?泣?????????????膣≪??????
163 procedure GetDirectoryList(Path: string; Mask: string; List: TStringList; SubDir: Boolean);
164
165 function DivideSubject(Line: string): TSubjectRec;
166 property Setting: TSetting read FSetting write FSetting;
167 property Dolib: TDolib read FDolib write FDolib;
168
169 function UrlToID(url: string): string;
170 function UrlToServer(url: string): string;
171
172 function StrTokFirst(const s:string; const sep:TStrTokSeparator; var Rec:TStrTokRec):string;
173 function StrTokNext(const sep:TStrTokSeparator; var Rec:TStrTokRec): string;
174
175 function GetFileSize(FileName : string) : longint;
176 function GetFileLineCount(FileName : string): longint;
177 function IntToDateTime(val: Int64): TDateTime;
178 function DateTimeToInt(ADate: TDateTime): Int64;
179
180 function ReadThreadFile(FileName: string; Line: Integer): string;
181
182 procedure MenuFont(Font: TFont);
183
184 function RemoveToken(var s:string; const delimiter:string):string;
185 function GetTokenIndex(s: string; delimiter: string; index: Integer): string;
186
187 function GetShortName(const LongName: string; ALength: integer): string;
188 function BoolToInt(b: Boolean): Integer;
189 function IntToBool(i: Integer): Boolean;
190 function GzipDecompress(ResStream: TStream; ContentEncoding: string): string;
191 procedure LoadKeySetting(ActionList: TActionList; FileName: String);
192 procedure SaveKeySetting(ActionList: TActionList; FileName: String);
193 procedure CreateProcess(const AppPath: string; const Param: string);
194 procedure OpenBrowser(URL: string; BrowserType: TGikoBrowserType);
195 function HTMLDecode(const AStr: String): String;
196 function GetHRefText(s: string): string;
197 function Is2chHost(Host: string): Boolean;
198 function Parse2chURL(const url: string; const path: string; const document: string; var BBSID: string; var BBSKey: string): Boolean;
199 function Parse2chURL2(URL: string): TPathRec;
200 procedure ParseURI(const URL : string; var Protocol, Host, Path, Document, Port, Bookmark: string);
201 function GetVersionBuild: Integer;
202 function GetBrowsableThreadURL( inURL : string ) : string;
203 function GetThreadURL2BoardURL( inURL : string ) : string;
204 function Get2chThreadURL2BoardURL( inURL : string ) : string;
205 function Get2chBrowsableThreadURL( inURL : string ) : string;
206 function Get2chBoard2ThreadURL( inBoard : TBoard; inKey : string ) : string;
207 procedure ListBoardFile;
208 procedure ReadBoardFile( bbs : TBBS );
209
210 function GetUnknownCategory : TCategory;
211 function GetUnknownBoard( inPlugIn : TBoardPlugIn; inURL : string ) : TBoard;
212
213 procedure GetPopupResNumber(URL : string; var stRes, endRes : Int64);
214
215 property Bayesian : TGikoBayesian read FBayesian write FBayesian;
216 function GetSameIDResAnchor(const AID : string; ThreadItem: TThreadItem; limited: Integer):string; overload;
217 function GetSameIDResAnchor(AIDNum : Integer; ThreadItem: TThreadItem; limited: Integer):string; overload;
218 procedure GetSameIDRes(const AID : string; ThreadItem: TThreadItem;var body: TStringList); overload;
219 procedure GetSameIDRes(AIDNum : Integer; ThreadItem: TThreadItem;var body: TStringList); overload;
220 function GetSameIDResCount(const AID : string; ThreadItem: TThreadItem):Integer; overload;
221 function GetSameIDResCount(AIDNum : Integer; ThreadItem: TThreadItem):Integer; overload;
222 function GetResID(AIDNum: Integer; ThreadItem: TThreadItem): String;
223 //! ??茯?茹f??
224 procedure SpamCountWord( const text : string; wordCount : TWordCount );
225 //! 絖????????/span>
226 procedure SpamForget( wordCount : TWordCount; isSpam : Boolean );
227 //! ?鴻????絖??
228 procedure SpamLearn( wordCount : TWordCount; isSpam : Boolean );
229 //! ?鴻????綺???/span>
230 function SpamParse( const text : string; wordCount : TWordCount ) : Extended;
231 //綣??違?????ヤ??с?????祉?с????????????茯帥?鴻??
232 function NotDateorTimeString(const AStr : string): boolean;
233
234 //! 綣??違???????????????ヤ?/ID????E????絖????????c?????????????<?ゃ???吾?????潟????菴遵??
235 function AddBeProfileLink(AID : string; ANum: Integer): string;
236 //! ???若?吾?с?恰???宴????
237 function GetVersionInfo(KeyWord: TVerResourceKey): string;
238 //! Plugin?????宴????
239 function GetPluginsInfo(): string;
240 //! IE?????若?吾?с?恰???宴????
241 function GetIEVersion: string;
242 function SetUserOptionalStyle(): string;
243 //! ???潟???????<???祉?若?吾??荐??????
244 procedure SetGikoMessage;
245 //! ???潟???????<???祉?若?吾????緇?????
246 function GetGikoMessage(MesType: TGikoMessageListType): String;
247 //! GMT?????祉??TDateTime?????????
248 function DateStrToDateTime(const DateStr: string): TDateTime;
249 //! User32.dll???????с??????
250 function CanUser32DLL: Boolean;
251 //! OE綣??????緇?
252 function GetOEIndentChar : string;
253 //! 臀??┃絎????<?ゃ????
254 function GetReplaceFileName: String;
255 //! ?ゃ?潟???????鴻??????dat鐚???????dat鐚???申??
256 procedure AddOutofIndexDat(Board: TBoard; DatList: TStringList; AllCreate: boolean = True);
257 //! ???<?ゃ???????????鴻??????篏????ャ????
258 function GetCreateDateFromName(FileName: String): TDateTime;
259 function GetExtpreviewFileName: String;
260
261 procedure ShowRefCount(msg: String; unk: IUnknown);
262 end;
263
264 var
265 GikoSys: TGikoSys;
266 const
267 //LENGTH_RESTITLE = 40;
268 ZERO_DATE: Integer = 25569;
269 BETA_VERSION_NAME_E = 'beta';
270 BETA_VERSION_NAME_J = '鐓?鐓?鐓?';
271 BETA_VERSION = 58;
272 BETA_VERSION_BUILD = ''; //!< debug??????/span>
273 APP_NAME = 'gikoNavi';
274 BE_PHP_URL = 'http://be.2ch.net/test/p.php?i=';
275
276
277 implementation
278
279 uses
280 Giko, RoundData, Favorite, Registry, HTMLCreate, MojuUtils, Sort, YofUtils,
281 IniFiles, DateUtils, SkinFiles;
282
283 const
284 FOLDER_INDEX_VERSION = '1.01';
285 USER_AGENT = 'Monazilla';
286 DEFAULT_NGWORD_FILE_NAME : String = 'NGword.txt';
287 NGWORDs_DIR_NAME : String = 'NGwords';
288
289 READ_PATH: string = '/test/read.cgi/';
290 OLD_READ_PATH: string = '/test/read.cgi?';
291 KAKO_PATH: string = '/kako/';
292
293 KeyWordStr: array [TVerResourceKey] of String = (
294 'Comments',
295 'CompanyName',
296 'FileDescription',
297 'FileVersion',
298 'InternalName',
299 'LegalCopyright',
300 'LegalTrademarks',
301 'OriginalFilename',
302 'PrivateBuild',
303 'ProductName',
304 'ProductVersion',
305 'SpecialBuild');
306
307 // *************************************************************************
308 //! GikoSys?潟?潟?鴻????????/span>
309 // *************************************************************************
310 constructor TGikoSys.Create;
311 begin
312 Inherited;
313 FSetting := TSetting.Create;
314 FDolib := TDolib.Create;
315 FAWKStr := TAWKStr.Create(nil);
316 if DirectoryExists(GetConfigDir) = false then begin
317 CreateDir(GetConfigDir);
318 end;
319 FAbon := TAbon.Create;
320 FAbon.IgnoreKana := FSetting.IgnoreKana;
321 FAbon.Setroot(GetConfigDir+NGWORDs_DIR_NAME);
322 FAbon.GoHome;
323 FAbon.ReturnNGwordLineNum := FSetting.ShowNGLinesNum;
324 FAbon.SetNGResAnchor := FSetting.AddResAnchor;
325 FAbon.DeleteSyria := FSetting.DeleteSyria;
326 FAbon.Deleterlo := FSetting.AbonDeleterlo;
327 FAbon.Replaceul := FSetting.AbonReplaceul;
328 FAbon.AbonPopupRes := FSetting.PopUpAbon;
329
330 FSelectResFilter := TAbon.Create;
331 FSelectResFilter.IgnoreKana := True;
332 // 腟???莨若????????サ??筝?荀с??荀????????祉???????????т????????????/span>
333 FSelectResFilter.AbonString := '';
334 //
335 ResRange := FSetting.ResRange;
336 FVersion := Trim(GetVersionInfo(vrFileVersion));
337 FBayesian := TGikoBayesian.Create;
338 //FBoardURLList := TStringList.Create;
339 //?<???祉?若?吾?????
340 FGikoMessage := TGikoMessage.Create;
341 end;
342
343 // *************************************************************************
344 //! GikoSys???鴻????????/span>
345 // *************************************************************************
346 destructor TGikoSys.Destroy;
347 var
348 i: Integer;
349 FileList: TStringList;
350 begin
351 //???潟??????TML??????/span>
352 FileList := TStringList.Create;
353 try
354 FileList.BeginUpdate;
355 GetFileList(GetTempFolder, '*.html', FileList, False, True);
356 FileList.EndUpdate;
357 for i := 0 to FileList.Count - 1 do begin
358 DeleteFile(FileList[i]);
359 end;
360 finally
361 FileList.Free;
362 end;
363 FreeAndNil(FGikoMessage);
364 FreeAndNil(FBayesian);
365 FreeAndNil(FSelectResFilter);
366 FreeAndNil(FAbon);
367 FreeAndNil(FAWKStr);
368 FreeAndNil(FDolib);
369 FreeAndNil(FSetting);
370 inherited;
371 end;
372
373 {!
374 \brief ??絖????医????с????/span>
375 \param s ???с??????????絖???
376 \return s ??膃?垬????贋?違???????茘????純???? True
377 }
378 {$HINTS OFF}
379 function TGikoSys.IsNumeric(s: string): boolean;
380 var
381 e: integer;
382 v: integer;
383 begin
384 Val(s, v, e);
385 Result := e = 0;
386 end;
387 {$HINTS ON}
388
389 {!
390 \brief ??絖???羌???絨?亥?号?医????с????/span>
391 \param s ???с??????????絖???
392 \return s ??膃?垬???羌???絨?違???????茘????純???? True
393 }
394 function TGikoSys.IsFloat(s: string): boolean;
395 var
396 v: Extended;
397 begin
398 Result := TextToFloat(PChar(s), v, fvExtended);
399 end;
400
401 // *************************************************************************
402 //! ???若?????<?ゃ??????緇?鐚????刻????<?ゃ????鐚?
403 // *************************************************************************
404 function TGikoSys.GetBoardFileName: string;
405 begin
406 Result := Setting.GetBoardFileName;
407 end;
408
409 // *************************************************************************
410 //! ???若?????<?ゃ??????緇?鐚????刻????<?ゃ????鐚?
411 // *************************************************************************
412 function TGikoSys.GetCustomBoardFileName: string;
413 begin
414 Result := Setting.GetCustomBoardFileName;
415 end;
416
417 // *************************************************************************
418 //! ???潟???????????????弱????緇?
419 // *************************************************************************
420 function TGikoSys.GetHtmlTempFileName: string;
421 begin
422 Result := Setting.GetHtmlTempFileName;
423 end;
424
425
426 // *************************************************************************
427 //! 絎?茵????<?ゃ????????????緇?
428 // *************************************************************************
429 function TGikoSys.GetAppDir: string;
430 begin
431 Result := Setting.GetAppDir;
432 end;
433
434 // *************************************************************************
435 //! TempHtml???<?ゃ??????緇?鐚????刻????<?ゃ????鐚?
436 // *************************************************************************
437 function TGikoSys.GetTempFolder: string;
438 begin
439 Result := Setting.GetTempFolder;
440 end;
441
442 // *************************************************************************
443 //! sent.ini???<?ゃ??????緇?鐚????刻????<?ゃ????鐚?
444 // *************************************************************************)
445 function TGikoSys.GetSentFileName: string;
446 begin
447 Result := Setting.GetSentFileName;
448 end;
449
450 // *************************************************************************
451 //! outbox.ini???<?ゃ??????緇?鐚????刻????<?ゃ????鐚?
452 // *************************************************************************
453 function TGikoSys.GetOutBoxFileName: string;
454 begin
455 Result := Setting.GetOutBoxFileName;
456 end;
457
458 // *************************************************************************
459 //! Config??????????緇?
460 // *************************************************************************
461 function TGikoSys.GetConfigDir: string;
462 begin
463 Result := Setting.GetConfigDir;
464 end;
465
466 //! ?鴻?帥?ゃ???激?若??????????
467 function TGikoSys.GetStyleSheetDir: string;
468 begin
469 Result := Setting.GetStyleSheetDir;
470 end;
471
472 //! ?鴻???潟????????
473 function TGikoSys.GetSkinDir: string;
474 begin
475 Result := Setting.GetSkinDir;
476 end;
477
478 //! Skin:???????????<?ゃ????
479 function TGikoSys.GetSkinHeaderFileName: string;
480 begin
481 Result := Setting.SkinFiles.GetSkinHeaderFileName;
482 end;
483
484 //! Skin:?????帥?????<?ゃ????
485 function TGikoSys.GetSkinFooterFileName: string;
486 begin
487 Result := Setting.SkinFiles.GetSkinFooterFileName;
488 end;
489
490 //! Skin:?亥?????鴻?????<?ゃ????
491 function TGikoSys.GetSkinNewResFileName: string;
492 begin
493 Result := Setting.SkinFiles.GetSkinNewResFileName;
494 end;
495
496 //! Skin:???亥?????鴻?????<?ゃ????
497 function TGikoSys.GetSkinResFileName: string;
498 begin
499 Result := Setting.SkinFiles.GetSkinResFileName;
500 end;
501
502 //! Skin:??????(?????障?ц?????)?????<?ゃ????
503 function TGikoSys.GetSkinBookmarkFileName: string;
504 begin
505 Result := Setting.SkinFiles.GetSkinBookmarkFileName;
506 end;
507
508 //! Skin:??????(?亥???????????<?ゃ????
509 function TGikoSys.GetSkinNewmarkFileName: string;
510 begin
511 Result := Setting.SkinFiles.GetSkinNewmarkFileName;
512 end;
513
514 //! UserAgent??緇?
515 function TGikoSys.GetUserAgent: string;
516 begin
517 if Dolib.Connected then begin
518 Result := Format('%s %s/%s%d/%s', [
519 Dolib.UserAgent,
520 APP_NAME,
521 BETA_VERSION_NAME_E,
522 BETA_VERSION,
523 Version]);
524 end else begin
525 Result := Format('%s/%s %s/%s%d/%s', [
526 USER_AGENT,
527 Dolib.Version,
528 APP_NAME,
529 BETA_VERSION_NAME_E,
530 BETA_VERSION,
531 Version]);
532 end;
533 end;
534
535 {!
536 \brief 腟?????? TDateTime ?????
537 \param val 1970/1/1/ 00:00:00 ??????????
538 \return val ??腓冴?? TDateTime
539 }
540 function TGikoSys.IntToDateTime(val: Int64): TDateTime;
541 begin
542 Result := ZERO_DATE + val / 86400.0;
543 end;
544
545 {!
546 \brief TDateTime ??腟?????????
547 \param ADate 紊???????????/span>
548 \return 1970/1/1/ 00:00:00 ??????????
549 }
550 function TGikoSys.DateTimeToInt(ADate: TDateTime): Int64;
551 begin
552 Result := Trunc((ADate - ZERO_DATE) * 86400);
553 end;
554
555
556 {!
557 \brief Subject???<?ゃ??ead
558 \param Board ?鴻???荀с????緇???????/span>
559 }
560 procedure TGikoSys.ReadSubjectFile(Board: TBoard);
561 var
562 ThreadItem: TThreadItem;
563 FileName: string;
564 FileList: TStringList;
565 Index: Integer;
566 sl: TStringList;
567 i: Integer;
568 Rec: TIndexRec;
569 UnRead: Integer;
570 usePlugIn : Boolean;
571 islog : Boolean;
572 urlHead: String;
573 datFileCheck: Boolean;
574 {*
575 FavoThreadItem : TFavoriteThreadItem;
576 Node: TTreeNode;
577 *}
578 {$IFDEF DEBUG}
579 st, rt: Cardinal;
580 {$ENDIF}
581 begin
582 {$IFDEF DEBUG}
583 st := GetTickCount;
584 {$ENDIF}
585 if Board.IsThreadDatRead then
586 Exit;
587 Board.Clear;
588 UnRead := 0;
589 usePlugIn := Board.IsBoardPlugInAvailable;
590 //server := UrlToServer( Board.URL );
591 // ?鴻???????у?演????RL??/span>
592 if Board.is2ch then begin
593 urlHead := UrlToServer( Board.URL ) + 'test/read.cgi/' + Board.BBSID + '/';
594 end else begin
595 urlHead := UrlToServer( Board.URL ) + 'test/read.cgi?bbs=' + Board.BBSID + '&key=';
596 end;
597
598 FileName := Board.GetFolderIndexFileName;
599
600 //
601 datFileCheck := (Setting.CheckDatFile) or (not FileExists(FileName));
602 if (datFileCheck) then begin
603 FileList := TStringList.Create;
604 FileList.Sorted := True;
605 FileList.BeginUpdate;
606 //IsLogFile??AT???<?ゃ?????鴻??
607 GetFileList(ExtractFileDir(Board.GetFolderIndexFileName), '*.dat', FileList, False);
608 FileList.EndUpdate;
609 end;
610
611 // ??茲????蚊??
612 Board.BeginUpdate;
613 Board.Sorted := True;
614 sl := TStringList.Create;
615 try
616 if FileExists(FileName) then begin
617 sl.LoadFromFile(FileName);
618 //鐚?茵???????鐚?鐚?茵????????若?吾?с?鰹?
619 for i := sl.Count - 1 downto 1 do begin
620 Rec := ParseIndexLine(sl[i]);
621 if (datFileCheck) then begin
622 islog := FileList.Find( Rec.FFileName, Index );
623 end else begin
624 islog := (Rec.FSize <> 0) and (Rec.FCount <> 0);
625 end;
626 if usePlugIn then
627 ThreadItem := TThreadItem.Create(
628 Board.BoardPlugIn,
629 Board,
630 Board.BoardPlugIn.FileName2ThreadURL( DWORD( Board ), Rec.FFileName ) )
631 else begin
632 if Board.is2ch then begin
633 ThreadItem := TThreadItem.Create(
634 nil,
635 Board,
636 urlHead + ChangeFileExt( Rec.FFileName, '' ) + '/l50',
637 islog,
638 Rec.FFileName
639 );
640 end else begin
641 ThreadItem := TThreadItem.Create(
642 nil,
643 Board,
644 urlHead + ChangeFileExt( Rec.FFileName, '' ) + '&ls=50',
645 islog,
646 Rec.FFileName
647 );
648 end;
649 end;
650
651 ThreadItem.BeginUpdate;
652 if (datFileCheck) and (islog) then
653 FileList.Delete( Index );
654
655 ThreadItem.No := Rec.FNo;
656 ThreadItem.FileName := Rec.FFileName;
657 ThreadItem.Title := MojuUtils.UnSanitize(Rec.FTitle);
658 ThreadItem.Count := Rec.FCount;
659 ThreadItem.Size := Rec.FSize;
660 ThreadItem.RoundDate := Rec.FRoundDate;
661 ThreadItem.LastModified := Rec.FLastModified;
662 ThreadItem.Kokomade := Rec.FKokomade;
663 ThreadItem.NewReceive := Rec.FNewReceive;
664 ThreadItem.UnRead := Rec.FUnRead;
665 ThreadItem.ScrollTop := Rec.FScrollTop;
666 ThreadItem.AllResCount := Rec.FAllResCount;
667 ThreadItem.NewResCount := Rec.FNewResCount;
668 ThreadItem.AgeSage := Rec.FAgeSage;
669 ThreadItem.ParentBoard := Board;
670 {* ??羂????ャ??紊ч??????潟?若?? *}
671 {*
672 FavoThreadItem := TFavoriteThreadItem.Create( ThreadItem.URL, ThreadItem.Title, ThreadItem );
673 Node := FavoriteDM.TreeView.Items.AddChildObject( FavoriteDM.TreeView.Items.Item[0], ThreadItem.Title, FavoThreadItem);
674 *}
675
676 ThreadItem.EndUpdate;
677 Board.Add(ThreadItem);
678
679 if (ThreadItem.UnRead) and (ThreadItem.IsLogFile) then
680 Inc(UnRead);
681 end;
682 end;
683
684 if UnRead <> Board.UnRead then
685 Board.UnRead := UnRead;
686
687 if (datFileCheck) then begin
688 //?ゃ?潟???????鴻???<???c?????違??菴遵??鐚??????ゃ?潟???????劫?綽?鐚?
689 AddOutofIndexDat(Board, FileList);
690 end;
691 Board.EndUpdate;
692
693 //?????医幻腟?篋??????с????/span>
694 RestoreThreadData( Board );
695 finally
696 sl.Free;
697 if (datFileCheck) then begin
698 FileList.Free;
699 end;
700 Board.Sorted := False;
701 end;
702 Board.IsThreadDatRead := True;
703 {$IFDEF DEBUG}
704 rt := GetTickCount - st;
705 Writeln('Read Done.' + IntToStr(rt) + ' ms');
706 {$ENDIF}
707 end;
708 {!
709 \brief ?ゃ?潟???????鴻??????dat鐚???????dat鐚???申??
710 \param Board 菴遵????????/span>
711 \param DatList dat???<?ゃ????
712 }
713 procedure TGikoSys.AddOutofIndexDat(Board: TBoard; DatList: TStringList; AllCreate: Boolean = True);
714 var
715 i : Integer;
716 Boardpath,FileName : String;
717 ResRec: TResRec;
718 ThreadItem: TThreadItem;
719 create: Boolean;
720 begin
721 create := False;
722 Boardpath := ExtractFilePath(Board.GetFolderIndexFileName);
723 //?ゃ?潟???????鴻???<???c?????違??菴遵??鐚??????ゃ?潟???????劫?綽?鐚?
724 for i := 0 to DatList.Count - 1 do begin
725 FileName := Boardpath + DatList[i];
726 ThreadItem := nil;
727 if (not AllCreate) then begin
728 create := False;
729 ThreadItem := Board.FindThreadFromFileName(DatList[i]);
730 if (ThreadItem = nil) then begin
731 create := True;
732 end else begin
733 if Board.IsBoardPlugInAvailable then begin
734 THTMLCreate.DivideStrLine(Board.BoardPlugIn.GetDat( DWORD( ThreadItem ), 1 ), @ResRec);
735 end else begin
736 THTMLCreate.DivideStrLine(ReadThreadFile(FileName, 1), @ResRec);
737 end;
738 end;
739 end;
740 if (ThreadItem = nil) then begin
741 if Board.IsBoardPlugInAvailable then begin
742 ThreadItem := TThreadItem.Create(
743 Board.BoardPlugIn,
744 Board,
745 Board.BoardPlugIn.FileName2ThreadURL( DWORD( Board ), DatList[i] ) );
746 THTMLCreate.DivideStrLine(Board.BoardPlugIn.GetDat( DWORD( ThreadItem ), 1 ), @ResRec);
747 end else begin
748 ThreadItem := TThreadItem.Create(
749 nil,
750 Board,
751 Get2chBoard2ThreadURL( Board, ChangeFileExt( DatList[i], '' ) ) );
752 THTMLCreate.DivideStrLine(ReadThreadFile(FileName, 1), @ResRec);
753 end;
754 end;
755
756
757 ThreadItem.BeginUpdate;
758 ThreadItem.FileName := DatList[i];
759 //ThreadItem.FilePath := FileName;
760 ThreadItem.No := Board.Count + 1;
761 ThreadItem.Title := ResRec.FTitle;
762 ThreadItem.Count := GetFileLineCount(FileName);
763 ThreadItem.AllResCount := ThreadItem.Count;
764 ThreadItem.NewResCount := ThreadItem.Count;
765 ThreadItem.Size := GetFileSize(FileName) - ThreadItem.Count;//1byte????????????????????????????????????
766 ThreadItem.RoundDate := FileDateToDateTime( FileAge( FileName ) );
767 ThreadItem.LastModified := ThreadItem.RoundDate;
768 ThreadItem.Kokomade := -1;
769 ThreadItem.NewReceive := 0;
770 ThreadItem.ParentBoard := Board;
771 ThreadItem.IsLogFile := True;
772 ThreadItem.Round := False;
773 ThreadItem.UnRead := False;
774 ThreadItem.ScrollTop := 0;
775 ThreadItem.AgeSage := gasNone;
776 ThreadItem.EndUpdate;
777 if (AllCreate) or (create) then begin
778 Board.Add(ThreadItem);
779 end;
780 end;
781 end;
782 {!
783 \brief ?鴻???????ゃ?潟???????鴻???<?ゃ??Folder.idx)篏???
784 \param Board Folder.idx ??篏?????????/span>
785 }
786 procedure TGikoSys.CreateThreadDat(Board: TBoard);
787 var
788 i: integer;
789 s: string;
790 SubjectList: TStringList;
791 sl: TStringList;
792 Rec: TSubjectRec;
793 FileName: string;
794 cnt: Integer;
795 begin
796 if not FileExists(Board.GetSubjectFileName) then Exit;
797 FileName := Board.GetFolderIndexFileName;
798
799 SubjectList := TStringList.Create;
800 try
801 SubjectList.LoadFromFile(Board.GetSubjectFileName);
802 sl := TStringList.Create;
803 try
804 cnt := 1;
805 sl.BeginUpdate;
806 sl.Add(FOLDER_INDEX_VERSION);
807 for i := 0 to SubjectList.Count - 1 do begin
808 Rec := DivideSubject(SubjectList[i]);
809
810 if (Trim(Rec.FFileName) = '') or (Trim(Rec.FTitle) = '') then
811 Continue;
812
813 {s := Format('%x', [cnt]) + #1 //???/span>
814 + Rec.FFileName + #1 //???<?ゃ????
815 + Rec.FTitle + #1 //?帥?ゃ????/span>
816 + Format('%x', [Rec.FCount]) + #1 //?????潟??
817 + Format('%x', [0]) + #1 //size
818 + Format('%x', [0]) + #1 //RoundDate
819 + Format('%x', [0]) + #1 //LastModified
820 + Format('%x', [0]) + #1 //Kokomade
821 + Format('%x', [0]) + #1 //NewReceive
822 + '0' + #1 //??戎??/span>
823 + Format('%x', [0]) + #1 //UnRead
824 + Format('%x', [0]) + #1 //ScrollTop
825 + Format('%x', [Rec.FCount]) + #1 //AllResCount
826 + Format('%x', [0]) + #1 //NewResCount
827 + Format('%x', [0]); //AgeSage
828 }
829 s := Format('%x'#1'%s'#1'%s'#1'%x'#1'%x'#1'%x'#1'%x'#1'%x'#1'%x'#1 +
830 '%s'#1'%x'#1'%x'#1'%x'#1'%x'#1'%x',
831 [cnt, //???/span>
832 Rec.FFileName, //???<?ゃ????
833 MojuUtils.Sanitize(Rec.FTitle), //?帥?ゃ????/span>
834 Rec.FCount, //?????潟??
835 0, //size
836 0, //RoundDate
837 0, //LastModified
838 0, //Kokomade
839 0, //NewReceive
840 '0', //??戎??/span>
841 0, //UnRead
842 0, //ScrollTop
843 Rec.FCount, //AllResCount
844 0, //NewResCount
845 0] //AgeSage
846 );
847
848 sl.Add(s);
849 inc(cnt);
850 end;
851 sl.EndUpdate;
852 sl.SaveToFile(FileName);
853 finally
854 sl.Free;
855 end;
856 finally
857 SubjectList.Free;
858 end;
859 end;
860
861 {!
862 \brief ?鴻???????ゃ?潟????????Thread.dat)?吾??莨若??/span>
863 \param Thread.dat ??篏?????????/span>
864 }
865 procedure TGikoSys.WriteThreadDat(Board: TBoard);
866 //const
867 // Values: array[Boolean] of string = ('0', '1');
868 var
869 i: integer;
870 FileName: string;
871 sl: TStringList;
872 s: string;
873 TmpFileList: TStringList;
874 begin
875 if not Board.IsThreadDatRead then
876 Exit;
877 FileName := Board.GetFolderIndexFileName;
878 ForceDirectoriesEx( ExtractFilePath( FileName ) );
879
880 sl := TStringList.Create;
881 TmpFileList := TStringList.Create;
882 TmpFileList.Sorted := true;
883 try
884 TmpFileList.BeginUpdate;
885 GetFileList(ExtractFileDir(Board.GetFolderIndexFileName), '*.tmp', TmpFileList, false);
886 TmpFileList.EndUpdate;
887 sl.BeginUpdate;
888 sl.Add(FOLDER_INDEX_VERSION);
889
890 // ?鴻????垬?絖????????純?若??
891 Sort.SetSortNoFlag(true);
892 Sort.SetSortOrder(true);
893 Sort.SetSortIndex(0);
894 //Sort.SortNonAcquiredCountFlag := GikoSys.Setting.NonAcquiredCount;
895 Board.CustomSort(ThreadItemSortProc);
896
897 for i := 0 to Board.Count - 1 do begin
898 Board.Items[i].No := i + 1;
899 s := Format('%x'#1'%s'#1'%s'#1'%x'#1'%x'#1'%x'#1'%x'#1'%x'#1'%x'#1 +
900 '%s'#1'%x'#1'%x'#1'%x'#1'%x'#1'%x',
901 [Board.Items[i].No, //???/span>
902 Board.Items[i].FileName, //???<?ゃ????
903 MojuUtils.Sanitize(Board.Items[i].Title), //?帥?ゃ????/span>
904 Board.Items[i].Count, //?????潟??
905 Board.Items[i].Size, //size
906 DateTimeToInt(Board.Items[i].RoundDate), //RoundDate
907 DateTimeToInt(Board.Items[i].LastModified), //LastModified
908 Board.Items[i].Kokomade, //Kokomade
909 Board.Items[i].NewReceive, //NewReceive
910 '0', //??戎??/span>
911 BoolToInt(Board.Items[i].UnRead), //UnRead
912 Board.Items[i].ScrollTop, //ScrollTop
913 Board.Items[i].AllResCount, //AllResCount
914 Board.Items[i].NewResCount, //NewResCount
915 Ord(Board.Items[i].AgeSage)] //AgeSage
916 );
917
918 sl.Add(s);
919 end;
920 sl.EndUpdate;
921 sl.SaveToFile(FileName);
922
923 for i := 0 to TmpFileList.Count - 1 do begin
924 DeleteFile(ExtractFilePath(Board.GetFolderIndexFileName) + TmpFileList[i]);
925 end;
926
927 finally
928 TmpFileList.Free;
929 sl.Free;
930 end;
931 end;
932
933 {!
934 \brief Folder.idx ?? 1 茵?茹i??
935 \param Line Folder.idx ??罕??????? 1 茵?
936 \return ?鴻??????????/span>
937 }
938 function TGikoSys.ParseIndexLine(Line: string): TIndexRec;
939 begin
940 Result.FNo := StrToIntDef('$' + MojuUtils.RemoveToken(Line, #1), 0);
941 Result.FFileName := MojuUtils.RemoveToken(Line, #1);
942 Result.FTitle := MojuUtils.UnSanitize(MojuUtils.RemoveToken(Line, #1));
943 Result.FCount := StrToIntDef('$' + MojuUtils.RemoveToken(Line, #1), 0);
944 Result.FSize := StrToIntDef('$' + MojuUtils.RemoveToken(Line, #1), 0);
945 Result.FRoundDate := IntToDateTime(StrToIntDef('$' + MojuUtils.RemoveToken(Line, #1), ZERO_DATE));
946 Result.FLastModified := IntToDateTime(StrToIntDef('$' + MojuUtils.RemoveToken(Line, #1), ZERO_DATE));
947 Result.FKokomade := StrToIntDef('$' + MojuUtils.RemoveToken(Line, #1), -1);
948 Result.FNewReceive := StrToIntDef('$' + MojuUtils.RemoveToken(Line, #1), 0);
949 RemoveToken(Line, #1);//9: ; //??戎??/span>
950 Result.FUnRead := IntToBool(StrToIntDef('$' + MojuUtils.RemoveToken(Line, #1), 0));
951 Result.FScrollTop := StrToIntDef('$' + MojuUtils.RemoveToken(Line, #1), 0);
952 Result.FAllResCount := StrToIntDef('$' + MojuUtils.RemoveToken(Line, #1), 0);
953 Result.FNewResCount := StrToIntDef('$' + MojuUtils.RemoveToken(Line, #1), 0);
954 Result.FAgeSage := TGikoAgeSage(StrToIntDef('$' + MojuUtils.RemoveToken(Line, #1), 0));
955
956 end;
957
958 {!
959 \brief ??絎???????????????絎????<?ゃ???荀с????緇?????
960 \param Path 莎欠?鴻??????????????????/span>
961 \param Mask ???<?ゃ?????????鴻??/span>
962 \param List OUT:??緇??????????<?ゃ????筝?荀с??菴???
963 \param SubDir 筝????????????障?у??絽亥???????鴻???????翫??? True
964 \param IsPathAdd ???剛????с???鴻???≪?????????翫??? True
965
966 Mask ?? '*.txt' ??????????絎??????????с??
967 ?劫??????<?ゃ???????劫????≦宍絖?????c?????鴻???≪?????????純?с????
968
969 \par 箴?:
970 \code
971 GetFileList('c:\', '*.txt', list, True, True);
972 \endcode
973 }
974 procedure TGikoSys.GetFileList(Path: string; Mask: string; var List: TStringList; SubDir: Boolean; IsPathAdd: Boolean);
975 var
976 rc: Integer;
977 SearchRec : TSearchRec;
978 s: string;
979 begin
980 Path := IncludeTrailingPathDelimiter(Path);
981 rc := FindFirst(Path + '*.*', faAnyfile, SearchRec);
982 try
983 while rc = 0 do begin
984 if (SearchRec.Name <> '..') and (SearchRec.Name <> '.') then begin
985 s := Path + SearchRec.Name;
986
987 if (SearchRec.Attr and faDirectory = 0) and (MatchesMask(s, Mask)) then
988 if IsPathAdd then
989 List.Add(s)
990 else
991 List.Add(SearchRec.Name);
992 if SubDir and (SearchRec.Attr and faDirectory > 0) then
993 GetFileList(s, Mask, List, True, IsPathAdd);
994 end;
995 rc := FindNext(SearchRec);
996 end;
997 finally
998 SysUtils.FindClose(SearchRec);
999 end;
1000 List.Sort;
1001 end;
1002
1003 {!
1004 \breif ??絎???????????????絎????<?ゃ???荀с????緇???????
1005 ?泣?????????????膣≪??????
1006 \param Path 莎欠?鴻??????????????????/span>
1007 \param Mask ???<?ゃ?????????鴻??/span>
1008 \param List OUT:??緇??????????<?ゃ????筝?荀с??菴???
1009 \param IsPathAdd ???剛????с???鴻???≪?????????翫??? True
1010 \note ??莎傑??絎????純? GetFileList() ?????????с?????∽?違???荀??
1011 \par 箴?
1012 \code
1013 GetFileList('c:\', '*.txt', list, True);
1014 \endcode
1015 }
1016 procedure TGikoSys.GetFileList(Path: string; Mask: string; var List: TStringList; IsPathAdd: Boolean);
1017 var
1018 rc: Integer;
1019 SearchRec : TSearchRec;
1020 begin
1021 Path := IncludeTrailingPathDelimiter(Path);
1022 rc := FindFirst(Path + Mask, faAnyfile, SearchRec);
1023 try
1024 while rc = 0 do begin
1025 if (SearchRec.Name <> '..') and (SearchRec.Name <> '.') then begin
1026 if (SearchRec.Attr and faDirectory = 0) then begin
1027 if IsPathAdd then begin
1028 List.Add(Path + SearchRec.Name)
1029 end else begin
1030 List.Add(SearchRec.Name);
1031 end;
1032 end;
1033 end;
1034 rc := FindNext(SearchRec);
1035 end;
1036 finally
1037 SysUtils.FindClose(SearchRec);
1038 end;
1039 List.Sort;
1040 end;
1041
1042 {!
1043 \brief ??絎????????????????c?????????荀с????緇?????
1044 \param Path 莎欠?鴻??????????????????/span>
1045 \param Mask ???????????????鴻??/span>
1046 \param List OUT:??緇?????????????????筝?荀с??菴???
1047 \param SubDir 筝????????????障?у??絽亥???????鴻???????翫??? True
1048
1049 Mask ?? '*.txt' ??????????絎??????????с??
1050 ?劫??????<?ゃ???????劫????≦宍絖?????c?????鴻???≪?????????純?с????
1051
1052 \par 箴?:
1053 \code
1054 GetDirectoryList('c:\', '*.txt', list, True);
1055 \endcode
1056 }
1057 procedure TGikoSys.GetDirectoryList(Path: string; Mask: string; List: TStringList; SubDir: Boolean);
1058 var
1059 rc: Integer;
1060 SearchRec : TSearchRec;
1061 s: string;
1062 begin
1063 Path := IncludeTrailingPathDelimiter(Path);
1064 rc := FindFirst(Path + '*.*', faDirectory, SearchRec);
1065 try
1066 while rc = 0 do begin
1067 if (SearchRec.Name <> '..') and (SearchRec.Name <> '.') then begin
1068 s := Path + SearchRec.Name;
1069 //if (SearchRec.Attr and faDirectory > 0) then
1070 // s := IncludeTrailingPathDelimiter(s)
1071
1072 if (SearchRec.Attr and faDirectory > 0) and (MatchesMask(s, Mask)) then
1073 List.Add( IncludeTrailingPathDelimiter( s ) );
1074 if SubDir and (SearchRec.Attr and faDirectory > 0) then
1075 GetDirectoryList(s, Mask, List, True);
1076 end;
1077 rc := FindNext(SearchRec);
1078 end;
1079 finally
1080 SysUtils.FindClose(SearchRec);
1081 end;
1082 end;
1083
1084
1085 {!
1086 \brief Subject.txt 筝?茵???茹i??
1087 \param Line Subject.txt ??罕??????? 1 茵?
1088 \return ?鴻??????????/span>
1089 }
1090 function TGikoSys.DivideSubject(Line: string): TSubjectRec;
1091 var
1092 i: integer;
1093 ws: WideString;
1094 Delim: string;
1095 LeftK: string;
1096 RightK: string;
1097 begin
1098 Result.FCount := 0;
1099
1100 if AnsiPos('<>', Line) = 0 then
1101 Delim := ','
1102 else
1103 Delim := '<>';
1104 Result.FFileName := RemoveToken(Line, Delim);
1105 Result.FTitle := Trim(RemoveToken(Line, Delim));
1106
1107 ws := Result.FTitle;
1108 if Copy(ws, Length(ws), 1) = ')' then begin
1109 LeftK := '(';
1110 RightK := ')';
1111 end else if Copy(ws, Length(ws)-1, 2) = '鐚?' then begin
1112 LeftK := '鐚?';
1113 RightK := '鐚?';
1114 end else if Copy(ws, Length(ws), 1) = '>' then begin
1115 LeftK := '<';
1116 RightK := '>';
1117 end;
1118 for i := Length(ws) - 1 downto 1 do begin
1119 if Copy(ws, i, Length(LeftK)) = LeftK then begin
1120 Result.FTitle := TrimRight(Copy(ws, 1, i - 1));
1121 ws := Copy(ws, i + Length(LeftK), Length(ws) - i - Length(RightK));
1122 if IsNumeric(ws) then
1123 Result.FCount := StrToInt(ws);
1124 //Delete(Result.FTitle, i, Length(LeftK) + Length(ws) + Length(RightK));
1125 break;
1126 end;
1127 end;
1128 end;
1129
1130 {!
1131 \brief URL????BBSID????緇?
1132 \param url BBSID ????緇????? URL
1133 \return BBSID
1134 }
1135 function TGikoSys.UrlToID(url: string): string;
1136 var
1137 i: integer;
1138 begin
1139 Result := '';
1140 url := Trim(url);
1141
1142 if url = '' then Exit;
1143 try
1144 url := Copy(url, 0, Length(url) - 1);
1145 for i := Length(url) downto 0 do begin
1146 if url[i] = '/' then begin
1147 Result := Copy(url, i + 1, Length(url));
1148 Break;
1149 end;
1150 end;
1151 except
1152 Result := '';
1153 end;
1154 end;
1155
1156 {!
1157 \brief URL??????緇????膣???????/span>
1158 \param url 茹i?????? URL
1159 \return ????????????緇?? URL
1160
1161 URL ???? BBSID篁ュ???????????緇?????????戎?????障????
1162 }
1163 function TGikoSys.UrlToServer(url: string): string;
1164 var
1165 i: integer;
1166 wsURL: WideString;
1167 begin
1168 Result := '';
1169 wsURL := url;
1170 wsURL := Trim(wsURL);
1171
1172 if wsURL = '' then exit;
1173
1174 if Copy(wsURL, Length(wsURL), 1) = '/' then
1175 wsURL := Copy(wsURL, 0, Length(wsURL) - 1);
1176
1177 for i := Length(wsURL) downto 0 do begin
1178 if wsURL[i] = '/' then begin
1179 Result := Copy(wsURL, 0, i);
1180 break;
1181 end;
1182 end;
1183 end;
1184
1185 {!
1186 \brief ???c??????????絖????????????с????/span>
1187 \param Name 絖?????腆肴?????????????????/span>
1188 \return ??????????絖??????????? True
1189 }
1190 function TGikoSys.DirectoryExistsEx(const Name: string): Boolean;
1191 var
1192 Code: Cardinal;
1193 begin
1194 Code := GetFileAttributes(PChar(Name));
1195 Result := (Code <> Cardinal(-1)) and (FILE_ATTRIBUTE_DIRECTORY and Code <> 0);
1196 end;
1197
1198 {!
1199 \brief ???c???????????鐚?茲??育??韻絲上?鐚?
1200 \param Dir 篏???????????/span>
1201 \return 篏??????????????翫??? True
1202 }
1203 function TGikoSys.ForceDirectoriesEx(Dir: string): Boolean;
1204 begin
1205 Result := True;
1206 if Length(Dir) = 0 then
1207 raise Exception.Create('??????????篏????堺?ャ?障????');
1208 Dir := ExcludeTrailingPathDelimiter(Dir);
1209 if (Length(Dir) < 3) or DirectoryExistsEx(Dir)
1210 or (ExtractFilePath(Dir) = Dir) then Exit; // avoid 'xyz:\' problem.
1211 Result := ForceDirectoriesEx(ExtractFilePath(Dir)) and CreateDir(Dir);
1212 end;
1213
1214 {!
1215 \brief ??絖??????????若???潟???????冴??鐚?????????鐚?
1216 FDelphi????????????/span>
1217 \param s ???????????c??????/span>
1218 \param sep ?阪????????????絖???
1219 \param Rec OUT:??絖???莎井?紙???宴??菴???
1220 \return ?????冴???????若????/span>
1221 \todo Split, RemoveToken, GetTokenIndex, NthField 茵???
1222 }
1223 function TGikoSys.StrTokFirst(const s:string; const sep: TStrTokSeparator; var Rec: TStrTokRec): string;
1224 begin
1225 Rec.Str := s;
1226 Rec.Pos := 1;
1227 Result := StrTokNext(sep, Rec);
1228 end;
1229
1230 {!
1231 \brief ??絖??????????若???潟???????冴??
1232 FDelphi????????????/span>
1233 \param sep ?阪?????????????c??????/span>
1234 \param Rec IN/OUT:StrTokFirst?т???????????絖???莎井?紙????/span>
1235 \return ?????冴???????若????/span>
1236 \todo Split, RemoveToken, GetTokenIndex, NthField 茵???
1237 }
1238 function TGikoSys.StrTokNext(const sep: TStrTokSeparator; var Rec: TStrTokRec): string;
1239 var
1240 Len, I: Integer;
1241 begin
1242 with Rec do begin
1243 Len := Length(Str);
1244 Result := '';
1245 if Len >= Pos then begin
1246 while (Pos <= Len) and (Str[Pos] in sep) do begin
1247 Inc(Pos);
1248 end;
1249 I := Pos;
1250 while (Pos<= Len) and not (Str[Pos] in sep) do begin
1251 if IsDBCSLeadByte(Byte(Str[Pos])) then begin
1252 Inc(Pos);
1253 end;
1254 Inc(Pos);
1255 end;
1256 Result := Copy(Str, I, Pos - I);
1257 while (Pos <= Len) and (Str[Pos] in sep) do begin// ????????絅純??/span>
1258 Inc(Pos);
1259 end;
1260 end;
1261 end;
1262 end;
1263
1264 {!
1265 \brief ???<?ゃ???泣?ゃ?阪??
1266 \param FileName ???<?ゃ???泣?ゃ?冴????緇????????<?ゃ??????/span>
1267 \return ???<?ゃ???泣?ゃ??bytes)
1268 }
1269 function TGikoSys.GetFileSize(FileName : string): longint;
1270 var
1271 F : File;
1272 begin
1273 try
1274 if not FileExists(FileName) then begin
1275 Result := 0;
1276 Exit;
1277 end;
1278 Assign(F, FileName);
1279 Reset(F, 1);
1280 Result := FileSize(F);
1281 CloseFile(F);
1282 except
1283 Result := 0;
1284 end;
1285 end;
1286
1287 {!
1288 \brief ?????鴻?????<?ゃ??????違????緇?
1289 \param FileName 茵??違????緇????????<?ゃ??????/span>
1290 \return 茵???/span>
1291 \todo ?<?≪?????????????<?ゃ?????
1292 }
1293 function TGikoSys.GetFileLineCount(FileName : string): longint;
1294 var
1295 sl: TStringList;
1296 begin
1297 sl := TStringList.Create;
1298 try
1299 try
1300 sl.LoadFromFile(FileName);
1301 Result := sl.Count;
1302 except
1303 Result := 0;
1304 end;
1305 finally
1306 sl.Free;
1307 end;
1308
1309 end;
1310
1311 {!
1312 \brief ???<?ゃ????????絎?茵?????緇?
1313 \param FileName ???<?ゃ????????/span>
1314 \param Line ??絎?茵?
1315 \return ??絎??????? 1 茵?
1316 \todo ?<?≪?????????????<?ゃ?????
1317 }
1318 function TGikoSys.ReadThreadFile(FileName: string; Line: Integer): string;
1319 var
1320 fileTmp : TStringList;
1321 begin
1322 Result := '';
1323 if FileExists(FileName) then begin
1324 fileTmp := TStringList.Create;
1325 try
1326 try
1327 fileTmp.LoadFromFile( FileName );
1328 if ( Line >= 1 ) and ( Line < fileTmp.Count + 1 ) then begin
1329 Result := fileTmp.Strings[ Line-1 ];
1330 end;
1331 except
1332 //on EFOpenError do Result := '';
1333 end;
1334 finally
1335 fileTmp.Free;
1336 end;
1337 end;
1338 end;
1339
1340 {!
1341 \brief ?激?鴻?????<???ャ?若?????潟??????с????緇?
1342 \param Font OUT:??緇??????????潟??絮??с??菴???
1343 }
1344 procedure TGikoSys.MenuFont(Font: TFont);
1345 var
1346 lf: LOGFONT;
1347 nm: NONCLIENTMETRICS;
1348 begin
1349 nm.cbSize := sizeof(NONCLIENTMETRICS);
1350 SystemParametersInfo(SPI_GETNONCLIENTMETRICS, 0, @nm, 0);
1351 lf := nm.lfMenuFont;
1352 Font.Name := lf.lfFaceName;
1353 Font.Height := lf.lfHeight;
1354 Font.Style := [];
1355 if lf.lfWeight >= 700 then
1356 Font.Style := Font.Style + [fsBold];
1357 if lf.lfItalic = 1 then
1358 Font.Style := Font.Style + [fsItalic];
1359 end;
1360
1361 {!
1362 \brief ?????????若???潟???????冴??
1363 \param s IN/OUT:??????????絖??????????冴????緇??????????絖???
1364 \param delimiter ?阪????????????絖???
1365 \return ?????冴??????絖???
1366
1367 ?????????泣?ゃ??????????????/span>
1368 }
1369 function TGikoSys.RemoveToken(var s: string;const delimiter: string): string;
1370 var
1371 p: Integer;
1372 begin
1373 p := AnsiPos(delimiter, s);
1374 if p = 0 then
1375 Result := s
1376 else
1377 Result := Copy(s, 1, p - 1);
1378 Delete(s, 1, Length(Result) + Length(delimiter));
1379 end;
1380
1381
1382 {!
1383 \brief n ?????????若???潟???????冴??
1384 \param s ??????????絖???
1385 \param index 0 ????紮??障???ゃ?潟????????n ????? n)
1386 \return ?????冴???????若????/span>
1387
1388 ?????????泣?ゃ??????????????/span>
1389 }
1390 function TGikoSys.GetTokenIndex(s: string; delimiter: string; index: Integer): string;
1391 var
1392 i: Integer;
1393 begin
1394 Result := '';
1395 for i := 0 to index do
1396 Result := RemoveToken(s, delimiter);
1397 end;
1398
1399
1400 //?ゃ?潟???????号???贋?違???????<?????????激?ワ?
1401 {procedure TGikoSys.FlashExitWrite;
1402 var
1403 i: Integer;
1404 begin
1405 //?鴻?????????若?帥???<?ゃ?????贋??/span>
1406 for i := 0 to FExitWrite.Count - 1 do
1407 WriteThreadDat(FExitWrite[i]);
1408 FExitWrite.Clear;
1409 end;}
1410
1411 {!
1412 \brief ?鴻???????????????????????????
1413 \param LongName ??????????絖???
1414 \param ALength ????????絖?????bytes)
1415 \return 紊???????????絖???
1416
1417 from HotZonu
1418 }
1419 function TGikoSys.GetShortName(const LongName: string; ALength: integer): string;
1420 const
1421 ERASECHAR : array [1..39] of string =
1422 ('??','??','??','??#39;,'??','??','鐚?#39;,'鐚?','??#39;,'??#39;,
1423 '??#39;,'??#39;,'??39;,'??','??#39;,'??','??','??#39;,'??','??',
1424 '??','??','??','??','??','??','鐚?','鐚?','??#39;,'??#39;,
1425 '鐔?','鐔?','??','??','??#39;,'??39;,'??','??#39;, '??');
1426 var
1427 Chr : array [0..255] of char;
1428 S : string;
1429 i : integer;
1430 begin
1431 s := Trim(LongName);
1432 if (Length(s) <= ALength) then begin
1433 Result := s;
1434 end else begin
1435 S := s;
1436 for i := Low(ERASECHAR) to High(ERASECHAR) do begin
1437 S := CustomStringReplace(S, ERASECHAR[i], '');
1438 end;
1439 if (Length(S) <= ALength) then begin
1440 Result := S;
1441 end else begin
1442 Windows.LCMapString(
1443 GetUserDefaultLCID(),
1444 LCMAP_HALFWIDTH,
1445 PChar(S),
1446 Length(S) + 1,
1447 chr,
1448 Sizeof(chr)
1449 );
1450 S := Chr;
1451 S := Copy(S,1,ALength);
1452 while true do begin
1453 if (ByteType(S, Length(S)) = mbLeadByte ) then begin
1454 S := Copy(S, 1, Length(S) - 1);
1455 end else begin
1456 Break;
1457 end;
1458 end;
1459 Result := S;
1460 end;
1461 end;
1462 end;
1463
1464 {!
1465 \brief Boolean ?? Integer ?????
1466 \return False..0, True..1
1467 }
1468 function TGikoSys.BoolToInt(b: Boolean): Integer;
1469 begin
1470 Result := IfThen(b, 1, 0);
1471 end;
1472
1473 {!
1474 \brief Integer ?? Boolean ?????
1475 \return 1..True, other..False
1476 \todo 0..False, other..True ???鴻?????????с??
1477 (?????罕????絖????????????????????????ф??信罩?
1478 }
1479 function TGikoSys.IntToBool(i: Integer): Boolean;
1480 begin
1481 Result := i = 1;
1482 end;
1483
1484 {!
1485 \brief gzip?у?х軒???????????祉??
1486 \param ResStream 茯??粋昭???鴻?????若??
1487 \param ContentEncoding ???潟?潟?若???c?潟??/span>
1488 \return 絮???????????絖???
1489 }
1490 function TGikoSys.GzipDecompress(ResStream: TStream; ContentEncoding: string): string;
1491 const
1492 BUF_SIZE = 4096;
1493 var
1494 GZipStream: TGzipDecompressStream;
1495 TextStream: TStringStream;
1496 buf: array[0..BUF_SIZE - 1] of Byte;
1497 cnt: Integer;
1498 s: string;
1499 i, ln: Integer;
1500 begin
1501 Result := '';
1502 TextStream := TStringStream.Create('');
1503 try
1504 //???若???潟???潟?????c????003絲丞?(x-gzip???????????帥????)
1505 // if LowerCase(Trim(ContentEncoding)) = 'gzip' then begin
1506 if AnsiPos('gzip', LowerCase(Trim(ContentEncoding))) > 0 then begin
1507 ResStream.Position := 0;
1508 GZipStream := TGzipDecompressStream.Create(TextStream);
1509 try
1510 repeat
1511 FillChar(buf, BUF_SIZE, 0);
1512 cnt := ResStream.Read(buf, BUF_SIZE);
1513 if cnt > 0 then
1514 GZipStream.Write(buf, BUF_SIZE);
1515 until cnt = 0;
1516 finally
1517 GZipStream.Free;
1518 end;
1519 end else begin
1520 ResStream.Position := 0;
1521 repeat
1522 FillChar(buf, BUF_SIZE, 0);
1523 cnt := ResStream.Read(buf, BUF_SIZE);
1524 if cnt > 0 then
1525 TextStream.Write(buf, BUF_SIZE);
1526 until cnt = 0;
1527 end;
1528
1529 //NULL??絖???"*"??????
1530 s := TextStream.DataString;
1531 i := Length(s);
1532 ln := i;
1533 while (i > 0) and (s[i] = #0) do
1534 Dec(i);
1535 Delete(s, i + 1, ln - i);
1536
1537 i := Pos(#0, s);
1538 while i <> 0 do begin
1539 s[i] := '*';
1540 i := Pos(#0, s);
1541 end;
1542
1543 Result := s;
1544 finally
1545 TextStream.Free;
1546 end;
1547 end;
1548
1549 {!
1550 \brief ?≪???激?с?潟???激?с?若???????????若??荐??
1551 \param ActionList 荐???????≪???激?с?割?荀?/span>
1552 \param FileName Ini???<?ゃ????????
1553 }
1554 procedure TGikoSys.LoadKeySetting(ActionList: TActionList; FileName: String);
1555 const
1556 STD_SEC = 'KeySetting';
1557 var
1558 i: Integer;
1559 ini: TMemIniFile;
1560 ActionName: string;
1561 ActionKey: Integer;
1562 SecList: TStringList;
1563 Component: TComponent;
1564 begin
1565 if not FileExists(fileName) then
1566 Exit;
1567 SecList := TStringList.Create;
1568 ini := TMemIniFile.Create(fileName);
1569 try
1570 ini.ReadSection(STD_SEC, SecList);
1571 for i := 0 to SecList.Count - 1 do begin
1572 ActionName := SecList[i];
1573 ActionKey := ini.ReadInteger(STD_SEC, ActionName, -1);
1574 if ActionKey <> -1 then begin
1575 Component := ActionList.Owner.FindComponent(ActionName);
1576 if TObject(Component) is TAction then begin
1577 TAction(Component).ShortCut := ActionKey;
1578 end;
1579 end;
1580 end;
1581 finally
1582 ini.Free;
1583 SecList.Free;
1584 end;
1585 end;
1586
1587 {!
1588 \brief ?≪???激?с?潟??┃絎????????????激?с?若???????????若?????<?ゃ?????絖?
1589 \param ActionList 篆?絖??????≪???激?с?割?荀?/span>
1590 \param FileName Ini???<?ゃ????
1591
1592 ActionList ??┃絎????????????激?с?若???????????若?? FileName ???絖????障????
1593 }
1594 procedure TGikoSys.SaveKeySetting(ActionList: TActionList; FileName: String);
1595 const
1596 STD_SEC = 'KeySetting';
1597 var
1598 i: Integer;
1599 ini: TMemIniFile;
1600 begin
1601 ini := TMemIniFile.Create(GetConfigDir + FileName);
1602 try
1603 for i := 0 to ActionList.ActionCount - 1 do begin
1604 if ActionList.Actions[i].Tag = -1 then
1605 Continue;
1606 ini.WriteInteger(STD_SEC, ActionList.Actions[i].Name, TAction(ActionList.Actions[i]).ShortCut);
1607 end;
1608 ini.UpdateFile;
1609 finally
1610 ini.Free;
1611 end;
1612 end;
1613
1614
1615 {!
1616 \brief ?????祉?鴻??????
1617 \param AppPath 莎桁???????????祉?鴻?????<?ゃ??????/span>
1618 \param Param AppPath ??検??綣???/span>
1619 }
1620 procedure TGikoSys.CreateProcess(const AppPath: string; const Param: string);
1621 var
1622 PI: TProcessInformation;
1623 SI: TStartupInfo;
1624 Path: string;
1625 begin
1626 Path := '"' + AppPath + '"';
1627 if Param <> '' then
1628 Path := Path + ' ' + Param;
1629
1630 SI.Cb := SizeOf(Si);
1631 SI.lpReserved := nil;
1632 SI.lpDesktop := nil;
1633 SI.lpTitle := nil;
1634 SI.dwFlags := 0;
1635 SI.cbReserved2 := 0;
1636 SI.lpReserved2 := nil;
1637 SI.dwysize := 0;
1638 Windows.CreateProcess(nil,
1639 PChar(Path),
1640 nil,
1641 nil,
1642 False,
1643 0,
1644 nil,
1645 nil,
1646 SI,
1647 PI);
1648 end;
1649
1650 {!
1651 \brief Web ???????吟??莎桁??
1652 \param URL Web ???????吟?ц;腓冴???? URL
1653 \param BrowserType ???????吟???帥?ゃ??(IE ????????)
1654 }
1655 procedure TGikoSys.OpenBrowser(URL: string; BrowserType: TGikoBrowserType);
1656 begin
1657 case BrowserType of
1658 gbtIE:
1659 HlinkNavigateString(nil, PWideChar(WideString(URL)));
1660 gbtUserApp, gbtAuto:
1661 if (Setting.URLApp) and (FileExists(Setting.URLAppFile)) then
1662 GikoSys.CreateProcess(Setting.URLAppFile, URL)
1663 else
1664 HlinkNavigateString(nil, PWideChar(WideString(URL)));
1665 end;
1666 end;
1667
1668 {!
1669 \brief ??絖?絎?篏????с?????潟?若??
1670 \param AStr ???潟?若????????絖???
1671 \return ???潟?若??????????絖???
1672 }
1673 function TGikoSys.HTMLDecode(const AStr: String): String;
1674 var
1675 Sp, Rp, Cp, Tp: PChar;
1676 S: String;
1677 I, Code: Integer;
1678 Num: Boolean;
1679 begin
1680 SetLength(Result, Length(AStr));
1681 Sp := PChar(AStr);
1682 Rp := PChar(Result);
1683 //Cp := Sp;
1684 try
1685 while Sp^ <> #0 do begin
1686 case Sp^ of
1687 '&': begin
1688 //Cp := Sp;
1689 Inc(Sp);
1690 case Sp^ of
1691 'a': if AnsiStrPos(Sp, 'amp;') = Sp then
1692 begin
1693 Inc(Sp, 3);
1694 Rp^ := '&';
1695 end;
1696 'l',
1697 'g': if (AnsiStrPos(Sp, 'lt;') = Sp) or (AnsiStrPos(Sp, 'gt;') = Sp) then
1698 begin
1699 Cp := Sp;
1700 Inc(Sp, 2);
1701 while (Sp^ <> ';') and (Sp^ <> #0) do
1702 Inc(Sp);
1703 if Cp^ = 'l' then
1704 Rp^ := '<'
1705 else
1706 Rp^ := '>';
1707 end;
1708 'q': if AnsiStrPos(Sp, 'quot;') = Sp then
1709 begin
1710 Inc(Sp,4);
1711 Rp^ := '"';
1712 end;
1713 '#': begin
1714 Tp := Sp;
1715 Inc(Tp);
1716 Num := IsNumeric(Copy(Tp, 1, 1));
1717 while (Sp^ <> ';') and (Sp^ <> #0) do begin
1718 if (Num) and (not IsNumeric(Copy(Sp, 1, 1))) then
1719 Break;
1720 Inc(Sp);
1721 end;
1722 SetString(S, Tp, Sp - Tp);
1723 Val(S, I, Code);
1724 Rp^ := Chr((I));
1725 end;
1726 // else
1727 //raise EConvertError.CreateFmt(sInvalidHTMLEncodedChar,
1728 //[Cp^ + Sp^, Cp - PChar(AStr)])
1729 end;
1730 end
1731 else
1732 Rp^ := Sp^;
1733 end;
1734 Inc(Rp);
1735 Inc(Sp);
1736 end;
1737 except
1738 // on E:EConvertError do
1739 // raise EConvertError.CreateFmt(sInvalidHTMLEncodedChar,
1740 // [Cp^ + Sp^, Cp - PChar(AStr)])
1741 end;
1742 SetLength(Result, Rp - PChar(Result));
1743 end;
1744
1745 {!
1746 \brief HTML ???≪?潟???若?帥?違???? URL ????緇?
1747 \param s URL ????緇????? HTML
1748 \return ??緇????? URL
1749 }
1750 function TGikoSys.GetHRefText(s: string): string;
1751 var
1752 Index: Integer;
1753 Index2: Integer;
1754 begin
1755 Result := '';
1756 s := Trim(s);
1757 if s = '' then
1758 Exit;
1759
1760 Index := AnsiPos('href', LowerCase(s));
1761 if Index = 0 then
1762 Exit;
1763 s := Trim(Copy(s, Index + 4, Length(s)));
1764 s := Trim(Copy(s, 2, Length(s)));
1765
1766 //紮???????絖???'"'?????????ゃ??span>
1767 //if Copy(s, 1, 1) = '"' then begin
1768 if s[1] = '"' then begin
1769 s := Trim(Copy(s, 2, Length(s)));
1770 end;
1771
1772 Index := AnsiPos('"', s);
1773 if Index <> 0 then begin
1774 //'"'?障??RL??????
1775 s := Copy(s, 1, Index - 1);
1776 end else begin
1777 //'"'???<?????違?鴻???若?鴻??">"???????鴻?障?с??URL??????
1778 Index := AnsiPos(' ', s);
1779 Index2 := AnsiPos('>', s);
1780 if Index = 0 then
1781 Index := Index2;
1782 if Index > Index2 then
1783 Index := Index2;
1784 if Index <> 0 then
1785 s := Copy(s, 1, Index - 1)
1786 else
1787 //????篁ヤ??????ャ??????/span>
1788 ;
1789 end;
1790 Result := Trim(s);
1791 end;
1792
1793 {!
1794 \brief ???鴻??????鐚?鐔?鐔????????????с????????
1795 \param Host ???с???????????鴻????
1796 \return 2?<?????????????鴻???????? True
1797 }
1798 function TGikoSys.Is2chHost(Host: string): Boolean;
1799 const
1800 HOST_NAME: array[0..1] of string = ('2ch.net', 'bbspink.com');
1801 var
1802 i: Integer;
1803 // Len: Integer;
1804 begin
1805 Result := False;
1806 if RightStr( Host, 1 ) = '/' then
1807 Host := Copy( Host, 1, Length( Host ) - 1 );
1808 OutputDebugString(pchar(HOST_NAME[0]));
1809 for i := 0 to Length(HOST_NAME) - 1 do begin
1810 // Len := Length(HOST_NAME[i]);
1811 if (AnsiPos(HOST_NAME[i], Host) > 0) and
1812 (AnsiPos(HOST_NAME[i], Host) = (Length(Host) - Length(HOST_NAME[i]) + 1)) then begin
1813 Result := True;
1814 Exit;
1815 end;
1816 end;
1817 end;
1818
1819 {!
1820 \brief 2?<????????綵√?? URL ????茹?/span>
1821 \param url 2?<????????綵√?? URL
1822 \param path test/read.cgi ??????賢??????ParseURI ????緇???)
1823 \param document index.html ???????????ャ?<?潟????(ParseURI ????緇???)
1824 \param BBSID OUT:BBSID ??菴???(ex. giko)
1825 \param BBSKey OUT:?鴻?????????若??菴???(ex. 10000000000)
1826 \return 2?<????????? URL ????????茹c?с???????? True
1827 }
1828 function TGikoSys.Parse2chURL(const url: string; const path: string; const document: string; var BBSID: string; var BBSKey: string): Boolean;
1829 var
1830 Index: Integer;
1831 s: string;
1832 SList: TStringList;
1833 begin
1834 BBSID := '';
1835 BBSKey := '';
1836 Result := False;
1837
1838 Index := AnsiPos(READ_PATH, path);
1839 if Index <> 0 then begin
1840 s := Copy(path, Index + Length(READ_PATH), Length(path));
1841
1842 if (Length(s) > 0) and (s[1] = '/') then
1843 Delete(s, 1, 1);
1844 BBSID := GetTokenIndex(s, '/', 0);
1845 BBSKey := GetTokenIndex(s, '/', 1);
1846 if BBSKey = '' then
1847 BBSKey := Document;
1848 Result := (BBSID <> '') or (BBSKey <> '');
1849 Exit;
1850 end;
1851 Index := AnsiPos(KAKO_PATH, path);
1852 if Index <> 0 then begin
1853 s := Copy(path, 2, Length(path));
1854 BBSID := GetTokenIndex(s, '/', 0);
1855 if (BBSID = 'log') and (GetTokenIndex(s, '/', 2) = 'kako') then
1856 BBSID := GetTokenIndex(s, '/', 1);
1857 BBSKey := ChangeFileExt(Document, '');
1858 Result := (BBSID <> '') or (BBSKey <> '');
1859 Exit;
1860 end;
1861 Index := AnsiPos('read.cgi?', URL);
1862 if Index <> 0 then begin
1863 SList := TStringList.Create;
1864 try
1865 try
1866 // s := HTMLDecode(Document);
1867 ExtractHTTPFields(['?', '&'], [], PChar(URL), SList, False);
1868 BBSID := SList.Values['bbs'];
1869 BBSKey := SList.Values['key'];
1870 Result := (BBSID <> '') or (BBSKey <> '');
1871 Exit;
1872 except
1873 Exit;
1874 end;
1875 finally
1876 SList.Free;
1877 end;
1878 end;
1879 end;
1880
1881 {!
1882 \brief 2ch 綵√?? URL ???????合??????緇?
1883 \param URL 2?<????????綵√?? URL
1884 \param stRes OUT:??紮????合????菴???
1885 \param endRes OUT:腟?篋????合????菴???
1886
1887 http://2ch.net/筝???32-50 \n
1888 ???翫?? stRef = 32, endRes = 50 ??????
1889 }
1890 procedure TGikoSys.GetPopupResNumber(URL : string; var stRes, endRes : Int64);
1891 var
1892 buf : String;
1893 convBuf : String;
1894 ps : Int64;
1895 pch : PChar;
1896 begin
1897 URL := Trim(LowerCase(URL));
1898 if (AnsiPos('&st=', URL ) <> 0) and ( AnsiPos( '&to=',URL) <> 0 ) then begin
1899 stRes := 0;
1900 endRes := 0;
1901 try
1902 buf := Copy( URL, AnsiPos('&st=', URL ) + 4, AnsiPos( '&to=',URL) - AnsiPos('&st=', URL ) - 4 );
1903 if buf <> '' then
1904 stRes := StrToInt64( buf );
1905 if AnsiPos( '&nofirst=',URL) <> 0 then begin
1906 buf := Copy( URL, AnsiPos('&to=', URL ) + 4, AnsiPos( '&nofirst=',URL) - AnsiPos('&to=', URL ) - 4);
1907 end else begin
1908 buf := Copy( URL, AnsiPos('&to=', URL ) + 4, Length( URL ) - AnsiPos('&to=', URL ) - 4 + 1 );
1909 ps := 0;
1910 pch := PChar(buf);
1911 while ( ps < Length(buf) )and ( pch[ps] >= '0' ) and ( pch[ps] <= '9' ) do Inc(ps);
1912 buf := Copy( buf, 1, ps );
1913 end;
1914 try
1915 if buf <> '' then
1916 endRes := StrToInt64(buf)
1917 except
1918 endRes := 0;
1919 end;
1920 except
1921 stRes := 0;
1922 end;
1923 if (stRes <> 0) and (endRes = 0) then
1924 endRes := stRes + MAX_POPUP_RES
1925 else if (stRes = 0) and (endRes <> 0) then begin
1926 stRes := endRes - MAX_POPUP_RES;
1927 if stRes < 1 then
1928 stRes := 1;
1929 end;
1930 GikoSys.GetBrowsableThreadURL( URL );
1931 end else if( AnsiPos('&res=', URL ) <> 0 ) then begin
1932 endRes := 0;
1933 buf := Copy( URL, AnsiPos('&res=', URL ) + 5, Length( URL ) - AnsiPos('&res=', URL ) - 5 + 1 );
1934 ps := 0;
1935 pch := PChar(buf);
1936 while ( ps < Length(buf) )and ( pch[ps] >= '0' ) and ( pch[ps] <= '9' ) do Inc(ps);
1937 buf := Copy( buf, 1, ps );
1938 try
1939 if buf <> '' then
1940 stRes := StrToInt(buf)
1941 else begin
1942 stRes := 0;
1943 end;
1944 except
1945 stRes := 0;
1946 end;
1947 end else if (AnsiPos('&start=', URL ) <> 0) and ( AnsiPos( '&end=',URL) <> 0 ) then begin
1948 try
1949 stRes := StrToInt64( Copy( URL, AnsiPos('&start=', URL ) + 7, AnsiPos( '&end=',URL) - AnsiPos('&start=', URL ) - 7 ) );
1950 if AnsiPos( '&nofirst=',URL) <> 0 then begin
1951 buf := Copy( URL, AnsiPos('&end=', URL ) + 5, AnsiPos( '&nofirst=',URL) - AnsiPos('&end=', URL ) - 5);
1952 end else begin
1953 buf := Copy( URL, AnsiPos('&end=', URL ) + 5, Length( URL ) - AnsiPos('&to=', URL ) - 5 + 1 );
1954 ps := 0;
1955 pch := PChar(buf);
1956 while ( ps < Length(buf) )and ( pch[ps] >= '0' ) and ( pch[ps] <= '9' ) do Inc(ps);
1957 buf := Copy( buf, 1, ps );
1958 end;
1959 try
1960 if buf <> '' then
1961 endRes := StrToInt64(buf);
1962 except
1963 endRes := 0;
1964 end;
1965 except
1966 stRes := 0;
1967 end;
1968 end else if ( AnsiPos('.html',URL) <> Length(URL) -4 ) and ( AnsiPos('.htm',URL) <> Length(URL) -3 ) then begin
1969 buf := Copy(URL, LastDelimiter('/',URL)+1,Length(URL)-LastDelimiter('/',URL)+1);
1970 if Length(buf) > 0 then begin
1971 if AnsiPos('-', buf) = 1 then begin
1972 stRes := 0;
1973 Delete(buf,1,1);
1974 ps := 0;
1975 pch := PChar(buf);
1976 while ( ps < Length(buf) )and ( pch[ps] >= '0' ) and ( pch[ps] <= '9' ) do Inc(ps);
1977 try
1978 convBuf := Copy( buf, 1, ps );
1979 if convBuf <> '' then
1980 endRes := StrToInt64(convBuf)
1981 else
1982 endRes := 0;
1983 except
1984 endRes := 0;
1985 end;
1986 if endRes <> 0 then begin
1987 stRes := endRes - MAX_POPUP_RES;
1988 if stRes < 1 then
1989 stRes := 1;
1990 end;
1991 end else begin
1992 ps := 0;
1993 pch := PChar(buf);
1994 while ( ps < Length(buf) )and ( pch[ps] >= '0' ) and ( pch[ps] <= '9' ) do Inc(ps);
1995 try
1996 convBuf := Copy( buf, 1, ps );
1997 if convBuf <> '' then begin
1998 stRes := StrToInt64(convBuf);
1999 Delete(buf,1,ps+1);
2000 ps := 0;
2001 pch := PChar(buf);
2002 while ( ps < Length(buf) )and ( pch[ps] >= '0' ) and ( pch[ps] <= '9' ) do Inc(ps);
2003 try
2004 convBuf := Copy( buf, 1, ps );
2005 if convBuf <> '' then
2006 endRes := StrToInt64(convBuf)
2007 else
2008 endRes := 0;
2009 except
2010 endRes := 0;
2011 end;
2012 end else begin
2013 stRes := 0;
2014 end;
2015 except
2016 stRes := 0;
2017 endRes := 0;
2018 end;
2019 end;
2020 end;
2021 end else begin
2022 //stRes := 0;
2023 //endRes := 0;
2024 end;
2025 end;
2026
2027 {!
2028 \brief 2?<????????綵√?? URL ????茹?/span>
2029 \param URL 2?<????????綵√?? URL
2030 \return ??茹c??????荀?膣?
2031 }
2032 function TGikoSys.Parse2chURL2(URL: string): TPathRec;
2033 var
2034 i: Integer;
2035 s: string;
2036 // buf : String;
2037 // convBuf : String;
2038 wk: string;
2039 wkMin: Integer;
2040 wkMax: Integer;
2041 wkInt: Integer;
2042 RStart: Integer;
2043 RLength: Integer;
2044 // ps : Integer;
2045 // pch : PChar;
2046 SList: TStringList;
2047 begin
2048 URL := Trim(LowerCase(URL));
2049 Result.FBBS := '';
2050 Result.FKey := '';
2051 Result.FSt := 0;
2052 Result.FTo := 0;
2053 Result.FFirst := False;
2054 Result.FStBegin := False;
2055 Result.FToEnd := False;
2056 Result.FDone := False;
2057 Result.FNoParam := False;
2058
2059 wkMin := 0;
2060 wkMax := 1;
2061 if URL[length(URL)] = '\' then
2062 URL := URL + 'n';
2063 FAWKStr.RegExp := 'http://.+\.(2ch\.net|bbspink\.com)/';
2064 if FAWKStr.Match(FAWKStr.ProcessEscSeq(URL), RStart, RLength) <> 0 then begin
2065 s := Copy(URL, RStart + RLength - 1, Length(URL));
2066
2067 //罔?羣??後?
2068 //??緇???50, 10, 10-20, 10n, 10-20n, -10, 10-, 10n- ????/span>
2069 //http://xxx.2ch.net/test/read.cgi/bbsid/1000000000/
2070 FAWKStr.RegExp := '/test/read.cgi/.+/[0-9]+/?.*';
2071 if FAWKStr.Match(FAWKStr.ProcessEscSeq(s), RStart, RLength) > 0 then begin
2072 s := Copy(s, 15, Length(s));
2073
2074 SList := TStringList.Create;
2075 try
2076 SList.Clear;
2077 FAWKStr.RegExp := '/';
2078 if FAWKStr.Split(FAWKStr.ProcessEscSeq(s), SList) >= 3 then begin
2079 Result.FBBS := SList[1];
2080 Result.FKey := SList[2];
2081 if SList.Count >= 4 then
2082 s := SList[3]
2083 else begin
2084 s := '';
2085 Result.FNoParam := true;
2086 end;
2087 end else
2088 Exit;
2089
2090 SList.Clear;
2091 FAWKStr.LineSeparator := mcls_CRLF;
2092 FAWKStr.RegExp := '-';
2093 if FAWKStr.Split(FAWKStr.ProcessEscSeq(s), SList) = 0 then begin
2094 Result.FFirst := True;
2095 end else begin
2096 FAWKStr.RegExp := 'l[0-9]+';
2097 if FAWKStr.Match(FAWKStr.ProcessEscSeq(s), RStart, RLength) > 0 then begin
2098 Result.FFirst := True;
2099 end else begin
2100 for i := 0 to SList.Count - 1 do begin
2101 if Trim(SList[i]) = '' then begin
2102 if i = 0 then
2103 Result.FStBegin := True;
2104 if i = (SList.Count - 1) then
2105 Result.FToEnd := True;
2106 end else if IsNumeric(SList[i]) then begin
2107 wkInt := StrToInt(SList[i]);
2108 wkMax := Max(wkMax, wkInt);
2109 if wkMin = 0 then
2110 wkMin := wkInt
2111 else
2112 wkMin := Min(wkMin, wkInt);
2113 end else if Trim(SList[i]) = 'n' then begin
2114 Result.FFirst := True;
2115 end else begin
2116 FAWKStr.RegExp := '^n[0-9]+$|^[0-9]+n$';
2117 if FAWKStr.Match(FAWKStr.ProcessEscSeq(SList[i]), RStart, RLength) > 0 then begin
2118 if Copy(SList[i], 1, 1) = 'n' then
2119 wkInt := StrToInt(Copy(SList[i], 2, Length(SList[i])))
2120 else
2121 wkInt := StrToInt(Copy(SList[i], 1, Length(SList[i]) - 1));
2122 Result.FFirst := True;
2123 wkMax := Max(wkMax, wkInt);
2124 if wkMin = 1 then
2125 wkMin := wkInt
2126 else
2127 wkMin := Min(wkMin, wkInt);
2128 end;
2129 end;
2130 end;
2131 if Result.FStBegin and (not Result.FToEnd) then
2132 Result.FSt := wkMin
2133 else if (not Result.FStBegin) and Result.FToEnd then
2134 Result.FTo := wkMax
2135 else if (not Result.FStBegin) and (not Result.FToEnd) then begin
2136 Result.FSt := wkMin;
2137 Result.FTo := wkMax;
2138 end;
2139 //Result.FSt := wkMin;
2140 //Result.FTo := wkMax;
2141 end;
2142 end;
2143 finally
2144 SList.Free;
2145 end;
2146 Result.FDone := True;
2147 Exit;
2148 end;
2149
2150 //??ako?後?
2151 //http://server.2ch.net/ITA_NAME/kako/1000/10000/1000000000.html
2152 FAWKStr.RegExp := '/.+/kako/[0-9]+/[0-9]+/[0-9]+\.html';
2153 if FAWKStr.Match(FAWKStr.ProcessEscSeq(s), RStart, RLength) > 0 then begin
2154 SList := TStringList.Create;
2155 try
2156 SList.Clear;
2157 FAWKStr.RegExp := '/';
2158 if FAWKStr.Split(FAWKStr.ProcessEscSeq(s), SList) >= 6 then begin
2159 Result.FBBS := SList[1];
2160 Result.FKey := ChangeFileExt(SList[5], '');
2161 Result.FFirst := True;
2162 end else
2163 Exit;
2164 finally
2165 SList.Free;
2166 end;
2167 Result.FDone := True;
2168 Exit;
2169 end;
2170
2171 //??ako?後?
2172 //http://server.2ch.net/ITA_NAME/kako/999/999999999.html
2173 FAWKStr.RegExp := '/.+/kako/[0-9]+/[0-9]+\.html';
2174 if FAWKStr.Match(FAWKStr.ProcessEscSeq(s), RStart, RLength) > 0 then begin
2175 SList := TStringList.Create;
2176 try
2177 SList.Clear;
2178 FAWKStr.RegExp := '/';
2179 if FAWKStr.Split(FAWKStr.ProcessEscSeq(s), SList) >= 5 then begin
2180 Result.FBBS := SList[1];
2181 Result.FKey := ChangeFileExt(SList[4], '');
2182 Result.FFirst := True;
2183 end else
2184 Exit;
2185 finally
2186 SList.Free;
2187 end;
2188 Result.FDone := True;
2189 Exit;
2190 end;
2191
2192 //log????og2?後?
2193 //http://server.2ch.net/log/ITA_NAME/kako/999/999999999.html
2194 //http://server.2ch.net/log2/ITA_NAME/kako/999/999999999.html
2195 FAWKStr.RegExp := '/log2?/.+/kako/[0-9]+/[0-9]+\.html';
2196 if FAWKStr.Match(FAWKStr.ProcessEscSeq(s), RStart, RLength) > 0 then begin
2197 SList := TStringList.Create;
2198 try
2199 SList.Clear;
2200 FAWKStr.RegExp := '/';
2201 if FAWKStr.Split(FAWKStr.ProcessEscSeq(s), SList) >= 6 then begin
2202 Result.FBBS := SList[2];
2203 Result.FKey := ChangeFileExt(SList[5], '');
2204 Result.FFirst := True;
2205 end else
2206 Exit;
2207 finally
2208 SList.Free;
2209 end;
2210 Result.FDone := True;
2211 Exit;
2212 end;
2213
2214
2215 //??RL?後?
2216 //http://server.2ch.net/test/read.cgi?bbs=ITA_NAME&key=1000000000&st=1&to=5&nofirst=true
2217 FAWKStr.RegExp := '/test/read\.cgi\?';
2218 if FAWKStr.Match(FAWKStr.ProcessEscSeq(s), RStart, RLength) > 0 then begin
2219 s := Copy(s, 16, Length(s));
2220 SList := TStringList.Create;
2221 try
2222 SList.Clear;
2223 FAWKStr.RegExp := '&';
2224 if FAWKStr.Split(FAWKStr.ProcessEscSeq(s), SList) >= 2 then begin
2225 Result.FFirst := True;
2226 for i := 0 to SList.Count - 1 do begin
2227 if Pos('bbs=', SList[i]) = 1 then begin
2228 Result.FBBS := Copy(SList[i], 5, Length(SList[i]));
2229 end else if Pos('key=', SList[i]) = 1 then begin
2230 Result.FKey := Copy(SList[i], 5, Length(SList[i]));
2231 end else if Pos('st=', SList[i]) = 1 then begin
2232 wk := Copy(SList[i], 4, Length(SList[i]));
2233 if IsNumeric(wk) then
2234 Result.FSt := StrToInt(wk)
2235 else if wk = '' then
2236 Result.FStBegin := True;
2237 end else if Pos('to=', SList[i]) = 1 then begin
2238 wk := Copy(SList[i], 4, Length(SList[i]));
2239 if IsNumeric(wk) then
2240 Result.FTo := StrToInt(wk)
2241 else if wk = '' then
2242 Result.FToEnd := True;
2243 end else if Pos('nofirst=', SList[i]) = 1 then begin
2244 Result.FFirst := False;
2245 end;
2246 end;
2247 end else
2248 Exit;
2249 finally
2250 SList.Free;
2251 end;
2252
2253 if (Result.FBBS <> '') and (Result.FKey <> '') then begin
2254 Result.FDone := True;
2255 end;
2256 Exit;
2257 end;
2258 end;
2259 end;
2260
2261 {!
2262 \brief URI ????茹?/span>
2263 \param URL ??茹c???? URI
2264 \param Protocol OUT:???????潟????菴???(ex. http)
2265 \param Host OUT:???鴻????菴???(ex. hoge.com)
2266 \param Path OUT:筝??????鴻??菴???(ex. test/read.cgi)
2267 \param Document OUT:?????ャ?<?潟??????菴???(ex. index.html)
2268 \param Port OUT:???若????菴???(ex. 8080)
2269 \param Bookmark OUT:?????????若???)??菴???
2270 }
2271 procedure TGikoSys.ParseURI(const URL : string; var Protocol, Host, Path, Document, Port, Bookmark: string);
2272 var
2273 URI: TIdURI;
2274 begin
2275 Protocol := '';
2276 Host := '';
2277 Path := '';
2278 Document := '';
2279 Port := '';
2280 Bookmark := '';
2281 URI := TIdURI.Create(URL);
2282 try
2283 Protocol := URI.Protocol;
2284 Host := URI.Host;
2285 Path := URI.Path;
2286 Document := URI.Document;
2287 Port := URI.Port;
2288 Bookmark := URI.Bookmark;
2289 finally
2290 URI.Free;
2291 end;
2292 end;
2293
2294 {!
2295 \brief ???潟?????????若?吾?с?潟????緇?
2296 \return ???若?吾?с?潟??? 2 罅?(dwFileVersionLS)
2297 }
2298 function TGikoSys.GetVersionBuild: Integer;
2299 var
2300 FixedFileInfo: PVSFixedFileInfo;
2301 VersionHandle, VersionSize: DWORD;
2302 pVersionInfo: Pointer;
2303 ItemLen : UInt;
2304 AppFile: string;
2305 begin
2306 Result := 0;
2307 AppFile := Application.ExeName;
2308 VersionSize := GetFileVersionInfoSize(pChar(AppFile), VersionHandle);
2309 if VersionSize = 0 then
2310 Exit;
2311 GetMem(pVersionInfo, VersionSize);
2312 try
2313 if GetFileVersionInfo(PChar(AppFile),VersionHandle,VersionSize, pVersionInfo) then
2314 if VerQueryValue(pVersionInfo, '\', Pointer(FixedFileInfo), ItemLen) then
2315 Result := LOWORD(FixedFileInfo^.dwFileVersionLS);
2316 finally
2317 FreeMem(pVersionInfo, VersionSize);
2318 end;
2319 end;
2320
2321 {!
2322 \brief ?鴻?????? URL ???荀??
2323 \param inURL 罩h????????鴻?????? URL
2324 \return 罩h??????????鴻?????? URL
2325
2326 ?鴻?????? URL ?????潟??????賢?т???????????荀?????障????
2327 筝??? URL ??????篋??с??URL ?????鴻????????絨????冴??篏?罐????????????障????\n
2328 罩h??????拷???????????泣?ゃ??????エ??????????????? URL ??????????????????障????
2329 (1-1000 ??????????激??????????????????????????
2330
2331 箴?(罩h?????):\n
2332 http://筝??? \n
2333 http://筝???20-100
2334
2335 (罩h???緇?):\n
2336 http://筝???l50
2337 }
2338 function TGikoSys.GetBrowsableThreadURL(
2339 inURL : string
2340 ) : string;
2341 var
2342 threadItem : TThreadItem;
2343 boardPlugIn : TBoardPlugIn;
2344 board : TBoard;
2345 i : Integer;
2346 begin
2347
2348 //===== ?????違?ゃ??/span>
2349 try
2350 for i := Length( BoardGroups ) - 1 downto 1 do begin
2351 if Assigned( Pointer( BoardGroups[i].BoardPlugIn.Module ) ) then begin
2352 if BoardGroups[i].BoardPlugIn.AcceptURL( inURL ) = atThread then begin
2353 board := BBSsFindBoardFromURL( BoardGroups[i].BoardPlugIn.ExtractBoardURL(inURL) );
2354 if board <> nil then begin
2355 boardPlugIn := BoardGroups[i].BoardPlugIn;
2356 threadItem := TThreadItem.Create( boardPlugIn, board, inURL );
2357 Result := threadItem.URL;
2358 threadItem.Free;
2359
2360 end;
2361 Exit;
2362 end;
2363 end;
2364 end;
2365 except
2366 // exception ???榊???????翫??????????????算?????????с?????с???????????
2367 end;
2368
2369 if Length( Result ) = 0 then
2370 Result := GikoSys.Get2chBrowsableThreadURL( inURL );
2371
2372 end;
2373
2374 {!
2375 \brief ?鴻?????? URL ??? URL ?????
2376 \param inURL ?鴻?????? URL
2377 \return ? URL
2378 }
2379 function TGikoSys.GetThreadURL2BoardURL(
2380 inURL : string
2381 ) : string;
2382 var
2383 threadItem : TThreadItem;
2384 boardPlugIn : TBoardPlugIn;
2385 board : TBoard;
2386 i : Integer;
2387 begin
2388
2389 //===== ?????違?ゃ??/span>
2390 try
2391 for i := Length( BoardGroups ) - 1 downto 1 do begin
2392 if Assigned( Pointer( BoardGroups[i].BoardPlugIn.Module ) ) then begin
2393 if BoardGroups[i].BoardPlugIn.AcceptURL( inURL ) = atThread then begin
2394 board := BBSsFindBoardFromURL(BoardGroups[i].BoardPlugIn.ExtractBoardURL(inURL));
2395 boardPlugIn := BoardGroups[i].BoardPlugIn;
2396 threadItem := TThreadItem.Create( boardPlugIn, board, inURL );
2397 Result := BoardGroups[i].BoardPlugIn.GetBoardURL( Longword( threadItem ) );
2398 threadItem.Free;
2399
2400 Break;
2401 end;
2402 end;
2403 end;
2404 except
2405 // exception ???榊???????翫??????????????算?????????с?????с???????????
2406 end;
2407
2408 if Length( Result ) = 0 then
2409 Result := GikoSys.Get2chThreadURL2BoardURL( inURL );
2410
2411 end;
2412
2413 {!
2414 \brief 2ch???鴻?????? URL ??? URL ?????
2415 \param inURL ?鴻?????? URL
2416 \return ? URL
2417 \see TGikoSys.GetThreadURL2BoardURL
2418 }
2419 function TGikoSys.Get2chThreadURL2BoardURL(
2420 inURL : string
2421 ) : string;
2422 var
2423 Protocol, Host, Path, Document, Port, Bookmark : string;
2424 BBSID, BBSKey : string;
2425 foundPos : Integer;
2426 begin
2427
2428 ParseURI( inURL, Protocol, Host, Path, Document, Port, Bookmark );
2429 Parse2chURL( inURL, Path, Document, BBSID, BBSKey );
2430
2431 foundPos := Pos( '/test/read.cgi', inURL );
2432 if {(Is2chHost(Host)) and} (foundPos > 0) then
2433 Result := Copy( inURL, 1, foundPos ) + BBSID + '/'
2434 else
2435 Result := Protocol + '://' + Host + '/' + BBSID + '/';
2436
2437 end;
2438
2439 {!
2440 \brief 2ch???鴻?????? URL ???荀??
2441 \param inURL 罩h????????鴻?????? URL
2442 \return 罩h??????????鴻?????? URL
2443 \see TGikoSys.GetBrowsableThreadURL
2444 }
2445 function TGikoSys.Get2chBrowsableThreadURL(
2446 inURL : string
2447 ) : string;
2448 var
2449 Protocol, Host, Path, Document, Port, Bookmark : string;
2450 BBSID, BBSKey : string;
2451 foundPos : Integer;
2452 begin
2453
2454 // if Pos( KAKO_PATH, inURL ) > 0 then begin
2455 // Result := inURL;
2456 // end else begin
2457 ParseURI( inURL, Protocol, Host, Path, Document, Port, Bookmark );
2458 Parse2chURL( inURL, Path, Document, BBSID, BBSKey );
2459 foundPos := Pos( '/test/read.cgi', inURL ) - 1;
2460
2461 if Is2chHost( Host ) then begin
2462 Result := Protocol + '://' + Host +
2463 READ_PATH + BBSID + '/' + BBSKey + '/l50';
2464 end else begin
2465 if foundPos > 0 then
2466 Result := Copy( inURL, 1, foundPos ) +
2467 OLD_READ_PATH + 'bbs=' + BBSID + '&key=' + BBSKey + '&ls=50'
2468 else
2469 Result := Protocol + '://' + Host +
2470 OLD_READ_PATH + 'bbs=' + BBSID + '&key=' + BBSKey + '&ls=50';
2471 end;
2472 // end;
2473
2474 end;
2475
2476 {!
2477 \brief 2ch??? URL ?????鴻?????? URL ??篏???
2478 \param inBoard ? URL
2479 \param inKey ?鴻??????????ex. 1000000000)
2480 \return ?鴻?????? URL
2481 }
2482 function TGikoSys.Get2chBoard2ThreadURL(
2483 inBoard : TBoard;
2484 inKey : string
2485 ) : string;
2486 var
2487 server : string;
2488 begin
2489
2490 server := UrlToServer( inBoard.URL );
2491 //if Is2chHost( server ) then
2492 if inBoard.Is2ch then
2493 Result := server + 'test/read.cgi/' + inBoard.BBSID + '/' + inKey + '/l50'
2494 else
2495 Result := server + 'test/read.cgi?bbs=' + inBoard.BBSID + '&key=' + inKey + '&ls=50';
2496
2497 end;
2498
2499 {!
2500 \brief ???若?????<?ゃ??????
2501
2502 ?????????? BBS(???若??) ? BBSs ???ャ???障????
2503 }
2504 procedure TGikoSys.ListBoardFile;
2505 var
2506 boardFileList : TStringList;
2507 i, l : Integer;
2508 begin
2509 // BBS ??????/span>
2510 try
2511 for i := 0 to Length( BBSs ) - 1 do
2512 BBSs[ i ].Free;
2513 except
2514 end;
2515 SetLength( BBSs, 0 );
2516
2517 l := 0;
2518 // ?帥???鴻????????
2519 if FileExists( GikoSys.GetBoardFileName ) then begin
2520 SetLength( BBSs, l + 1 );
2521 BBSs[ l ] := TBBS.Create( GikoSys.GetBoardFileName );
2522 BBSs[ l ].Title := '鐚??<????????';
2523 Inc( l );
2524 end;
2525
2526 if FileExists( GikoSys.GetCustomBoardFileName ) then begin
2527 SetLength( BBSs, l + 1 );
2528 BBSs[ l ] := TBBS.Create( GikoSys.GetCustomBoardFileName );
2529 BBSs[ l ].Title := '?????';
2530 Inc( l );
2531 end;
2532
2533 // Board ????????
2534 if DirectoryExists( GikoSys.Setting.GetBoardDir ) then begin
2535 BoardFileList := TStringList.Create;
2536 try
2537 BoardFileList.BeginUpdate;
2538 GikoSys.GetFileList( GikoSys.Setting.GetBoardDir, '*.txt', BoardFileList, True, True );
2539 BoardFileList.EndUpdate;
2540 SetLength( BBSs, l + BoardFileList.Count );
2541 for i := BoardFileList.Count - 1 downto 0 do begin
2542 BBSs[ l ] := TBBS.Create( BoardFileList[ i ] );
2543 BBSs[ l ].Title := ChangeFileExt( ExtractFileName( BoardFileList[ i ] ), '' );
2544 Inc( l );
2545 end;
2546 finally
2547 BoardFileList.Free;
2548 end;
2549 end;
2550 end;
2551
2552 {!
2553 \brief ???若?????<?ゃ????粋昭??/span>
2554 \param bbs ???若?????<?ゃ????茯??粋昭?? BBS
2555 }
2556 procedure TGikoSys.ReadBoardFile( bbs : TBBS );
2557 var
2558 // idx : Integer;
2559 ini : TMemIniFile;
2560 p : Integer;
2561 boardFile : TStringList;
2562 CategoryList : TStringList;
2563 BoardList : TStringList;
2564 Category : TCategory;
2565 Board : TBoard;
2566 inistr : string;
2567 tmpstring : string;
2568 // RoundItem : TRoundItem;
2569
2570 i, iBound : Integer;
2571 j, jBound : Integer;
2572 k, kBound : Integer;
2573 begin
2574
2575 if not FileExists( bbs.FilePath ) then
2576 Exit;
2577
2578 bbs.Clear;
2579 ini := TMemIniFile.Create('');
2580 boardFile := TStringList.Create;
2581
2582 try
2583 boardFile.LoadFromFile( bbs.FilePath );
2584
2585 ini.SetStrings( boardFile );
2586 CategoryList := TStringList.Create;
2587 BoardList := TStringList.Create;
2588 try
2589 ini.ReadSections( CategoryList );
2590
2591 iBound := CategoryList.Count - 1;
2592 for i := 0 to iBound do begin
2593 ini.ReadSection( CategoryList[i], BoardList );
2594 Category := TCategory.Create;
2595 Category.No := i + 1;
2596 Category.Title := CategoryList[i];
2597
2598 jBound := BoardList.Count - 1;
2599 for j := 0 to jBound do begin
2600 Board := nil;
2601 inistr := ini.ReadString(CategoryList[i], BoardList[j], '');
2602 //'http://'?????障??????絖??????????∴?????
2603 if (AnsiPos('http://', AnsiLowerCase(inistr)) = 0) then Continue;
2604 //===== ?????違?ゃ??/span>
2605 try
2606 kBound := Length(BoardGroups) - 1;
2607 for k := 1 to kBound do begin //0????2?<????
2608 if Assigned( Pointer( BoardGroups[k].BoardPlugIn.Module ) ) then begin
2609 if BoardGroups[k].BoardPlugIn.AcceptURL( inistr ) = atBoard then begin
2610 if not BoardGroups[k].Find(inistr, p) then begin
2611 tmpstring := BoardGroups[k].BoardPlugIn.ExtractBoardURL( inistr );
2612 if AnsiCompareStr(tmpString, inistr) <> 0 then begin
2613 if not BoardGroups[k].Find(tmpstring, p) then begin
2614 try
2615 Board := TBoard.Create( BoardGroups[k].BoardPlugIn, tmpstring );
2616 BoardGroups[k].AddObject(tmpstring, Board);
2617 Category.Add(Board);
2618 except
2619 //???????ャ??????????Board???????け????????????????Board??nil??????
2620 Board := nil;
2621 end;
2622 end else begin
2623 Board := TBoard(BoardGroups[k].Objects[p]);
2624 if Board.ParentCategory <> Category then
2625 Category.Add(Board);
2626 end;
2627 end else begin
2628 try
2629 Board := TBoard.Create( BoardGroups[k].BoardPlugIn, tmpstring );
2630 BoardGroups[k].AddObject(tmpstring, Board);
2631 Category.Add(Board);
2632 except
2633 //???????ャ??????????Board???????け????????????????Board??nil??????
2634 Board := nil;
2635 end;
2636 end;
2637 end else begin
2638 Board := TBoard(BoardGroups[k].Objects[p]);
2639 if Board.ParentCategory <> Category then
2640 Category.Add(Board);
2641 end;
2642 Break;
2643 end;
2644 end;
2645 end;
2646 except
2647 // exception ???榊???????翫??????????????算?????????с?????с???????????
2648 end;
2649 try
2650 if (Board = nil) then begin
2651 if not BoardGroups[0].Find(inistr,p) then begin
2652 Board := TBoard.Create( nil, inistr );
2653 BoardGroups[0].AddObject(inistr, Board);
2654 Category.Add(Board);
2655 end else begin
2656 Board := TBoard(BoardGroups[0].Objects[p]);
2657 if Board.ParentCategory <> Category then
2658 Category.Add(Board);
2659 end;
2660 end;
2661
2662 if (Board.Multiplicity = 0) then begin
2663 Board.BeginUpdate;
2664 Board.No := j + 1;
2665 Board.Multiplicity := 1;
2666 Board.Title := BoardList[j];
2667 Board.RoundDate := ZERO_DATE;
2668 Board.LoadSettings;
2669 Board.EndUpdate;
2670 end else begin
2671 Board.No := j + 1;
2672 Board.Multiplicity := Board.Multiplicity + 1;
2673 end;
2674 except
2675 end;
2676 end;
2677 bbs.Add( Category );
2678 end;
2679
2680
2681 //end;
2682 bbs.IsBoardFileRead := True;
2683 finally
2684 BoardList.Free;
2685 CategoryList.Free;
2686 end;
2687 finally
2688 boardFile.Free;
2689 ini.Free;
2690 end;
2691
2692 end;
2693
2694 {!
2695 \brief ??腱違??筝??????????眼????????
2696 \return ???????????????眼??/span>
2697 }
2698 function TGikoSys.GetUnknownCategory : TCategory;
2699 const
2700 UNKNOWN_CATEGORY = '(??腱遺???';
2701 begin
2702
2703 if Length( BBSs ) < 2 then begin
2704 Result := nil;
2705 Exit;
2706 end;
2707
2708 Result := BBSs[ 1 ].FindCategoryFromTitle( UNKNOWN_CATEGORY );
2709 if Result = nil then begin
2710 Result := TCategory.Create;
2711 Result.Title := UNKNOWN_CATEGORY;
2712 BBSs[ 1 ].Add( Result );
2713 end;
2714
2715 end;
2716
2717 {!
2718 \brief ??腱違??筝???? BBS ??????
2719 \return ?????????? BBS
2720 }
2721 function TGikoSys.GetUnknownBoard( inPlugIn : TBoardPlugIn; inURL : string ) : TBoard;
2722 var
2723 category : TCategory;
2724 const
2725 UNKNOWN_BOARD = '(??腱遺???';
2726 begin
2727
2728 category := GetUnknownCategory;
2729 if category = nil then begin
2730 Result := nil;
2731 end else begin
2732 Result := category.FindBoardFromTitle( UNKNOWN_BOARD );
2733 if Result = nil then begin
2734 Result := TBoard.Create( inPlugIn, inURL );
2735 Result.Title := UNKNOWN_BOARD;
2736 category.Add( Result );
2737 end;
2738 end;
2739
2740 end;
2741
2742 //! Samba.ini
2743 function TGikoSys.GetSambaFileName : string;
2744 begin
2745 Result := Setting.GetSambaFileName;
2746 end;
2747
2748 {!
2749 \brief ??????腮 ID ?????ゃ???鴻???≪?潟???若??????????
2750 \param AID ??篋冴???劫???????腮 ID
2751 \param ThreadItem ?????????鴻??????
2752 \param limited ?????????違???狗??????????1篁ヤ?
2753 \return ?????????????鴻?≪?潟????/span>
2754 }
2755 function TGikoSys.GetSameIDResAnchor(
2756 const AID : string; ThreadItem: TThreadItem;
2757 limited: Integer):string;
2758 var
2759 i: integer;
2760 body: TStringList;
2761 Res: TResRec;
2762 ResLink : TResLinkRec;
2763 begin
2764 // body篁ュ???戎???????????у????????????
2765 Res.FBody := '';
2766 Res.FType := glt2chNew;
2767
2768 Result := '';
2769 if (not IsNoValidID(AID)) and
2770 (ThreadItem <> nil) and (ThreadItem.IsLogFile) then begin
2771 body := TStringList.Create;
2772 try
2773 GetSameIDRes(AID, ThreadItem, body);
2774 if (limited > 0) and (body.Count > limited) then begin
2775 for i := body.Count - limited to body.Count - 1 do begin
2776 Res.FBody := Res.FBody + '&gt;' + body[i] + ' ';
2777 end;
2778 end else begin
2779 for i := 0 to body.Count - 1 do begin
2780 Res.FBody := Res.FBody + '&gt;' + body[i] + ' ';
2781 end;
2782 end;
2783 finally
2784 body.Free;
2785 end;
2786 ResLink.FBbs := ThreadItem.ParentBoard.BBSID;
2787 ResLink.FKey := ChangeFileExt(ThreadItem.FileName, '');
2788 HTMLCreater.ConvRes(@Res, @ResLink, false);
2789 Result := Res.FBody;
2790 end;
2791 end;
2792
2793 {!
2794 \brief ??????腮 ID ?????ゃ???鴻??????
2795 \param AID ??篋冴???劫???????腮 ID
2796 \param ThreadItem ?????????鴻??????
2797 \param body OUT:?????????????合??垩??菴???
2798 }
2799 procedure TGikoSys.GetSameIDRes(const AID : string; ThreadItem: TThreadItem;var body: TStringList);
2800 var
2801 i: integer;
2802 ReadList: TStringList;
2803 Res: TResRec;
2804 boardPlugIn : TBoardPlugIn;
2805 begin
2806 if (not IsNoValidID(AID)) and
2807 (ThreadItem <> nil) and (ThreadItem.IsLogFile) then begin
2808 //if ThreadItem.IsBoardPlugInAvailable then begin
2809 if ThreadItem.ParentBoard.IsBoardPlugInAvailable then begin
2810 //===== ?????違?ゃ?潟??????茵?ず
2811 //boardPlugIn := ThreadItem.BoardPlugIn;
2812 boardPlugIn := ThreadItem.ParentBoard.BoardPlugIn;
2813
2814 for i := 0 to threadItem.Count - 1 do begin
2815 // ????/span>
2816 THTMLCreate.DivideStrLine(boardPlugIn.GetDat(DWORD( threadItem ), i + 1), @Res);
2817 if(AnsiPos(AID, Res.FDateTime) > 0) then begin
2818 body.Add(IntToStr(i+1));
2819 end;
2820 end;
2821 end else begin
2822 ReadList := TStringList.Create;
2823 try
2824 ReadList.LoadFromFile(ThreadItem.GetThreadFileName);
2825 for i := 0 to ReadList.Count - 1 do begin
2826 THTMLCreate.DivideStrLine(ReadList[i], @Res);
2827 if AnsiPos(AID, Res.FDateTime) > 0 then begin
2828 body.Add(IntToStr(i+1));
2829 end;
2830 end;
2831 finally
2832 ReadList.Free;
2833 end;
2834 end;
2835 end;
2836 end;
2837
2838 {!
2839 \brief ??????腮 ID ?????ゃ???鴻??????
2840 \param AIDNum ??篋冴???劫???????腮 ID
2841 \param ThreadItem ?????????鴻??????
2842 \param limited ?????????違???狗??????????1篁ヤ?
2843 \return
2844 }
2845 function TGikoSys.GetSameIDResAnchor(AIDNum : Integer;
2846 ThreadItem: TThreadItem;
2847 limited: Integer):string;
2848 var
2849 i: integer;
2850 body: TStringList;
2851 Res: TResRec;
2852 ResLink : TResLinkRec;
2853 begin
2854 // body篁ュ???戎???????????у????????????
2855 Res.FBody := '';
2856 Res.FType := glt2chNew;
2857
2858 Result := '';
2859 if (ThreadItem <> nil) and (ThreadItem.IsLogFile) then begin
2860 body := TStringList.Create;
2861 try
2862 GetSameIDRes(AIDNum, ThreadItem, body);
2863 if (limited > 0) and ( body.Count > limited) then begin
2864 for i := body.Count - 20 to body.Count - 1 do begin
2865 Res.FBody := Res.FBody + '&gt;' + body[i] + ' ';
2866 end;
2867 end else begin
2868 for i := 0 to body.Count - 1 do begin
2869 Res.FBody := Res.FBody + '&gt;' + body[i] + ' ';
2870 end;
2871 end;
2872 finally
2873 body.Free;
2874 end;
2875 ResLink.FBbs := ThreadItem.ParentBoard.BBSID;
2876 ResLink.FKey := ChangeFileExt(ThreadItem.FileName, '');
2877 HTMLCreater.ConvRes(@Res, @ResLink, false);
2878 Result := Res.FBody;
2879 end;
2880 end;
2881
2882 {!
2883 \brief ??????腮 ID ?????ゃ???鴻??????
2884 \param AIDNum ??篋冴???劫???????腮 ID
2885 \param ThreadItem ?????????鴻??????
2886 \param body OUT:?????????????合??垩??菴???
2887 }
2888 procedure TGikoSys.GetSameIDRes(AIDNum : Integer; ThreadItem: TThreadItem;var body: TStringList);
2889 var
2890 AID : String;
2891 begin
2892 AID := GetResID(AIDNum, ThreadItem);
2893 if not IsNoValidID(AID) then begin
2894 GetSameIDRes(AID, ThreadItem, body);
2895 end;
2896 end;
2897 {!
2898 \brief ??腮 ID ??緇?
2899 \param AIDNum ??腮 ???合???/span>
2900 \param ThreadItem ??腮帥?鴻??????
2901 \param body OUT:??腮?D
2902 }
2903 function TGikoSys.GetResID(AIDNum: Integer; ThreadItem: TThreadItem): String;
2904 var
2905 Res: TResRec;
2906 boardPlugIn : TBoardPlugIn;
2907 stList: TStringList;
2908 i : Integer;
2909 begin
2910 Result := '';
2911 if (ThreadItem <> nil) and (ThreadItem.IsLogFile)
2912 and (AIDNum > 0) and (AIDNum <= ThreadItem.Count) then begin
2913 //if ThreadItem.IsBoardPlugInAvailable then begin
2914 if ThreadItem.ParentBoard.IsBoardPlugInAvailable then begin
2915 //===== ?????違?ゃ?潟??????茵?ず
2916 //boardPlugIn := ThreadItem.BoardPlugIn;
2917 boardPlugIn := ThreadItem.ParentBoard.BoardPlugIn;
2918 THTMLCreate.DivideStrLine(boardPlugIn.GetDat(DWORD( threadItem ), AIDNum), @Res);
2919 end else begin
2920 THTMLCreate.DivideStrLine( ReadThreadFile(ThreadItem.GetThreadFileName, AIDNum), @Res);
2921 end;
2922 Result := Res.FDateTime;
2923 if AnsiPos('id', AnsiLowerCase(Result)) > 0 then begin
2924 Result := Copy(Result, AnsiPos('id', AnsiLowerCase(Result)) - 1, 11);
2925 if AnsiPos(' be:', AnsiLowerCase(Result)) > 0 then begin
2926 Result := Copy(Result, 1, AnsiPos(' BE:', AnsiLowerCase(Result)) - 1)
2927 end;
2928 end else begin
2929 stlist := TStringList.Create;
2930 try
2931 stList.DelimitedText := Result;
2932 Result := '';
2933 for i := 0 to stList.Count - 1 do
2934 if Length(WideString(stList[i])) = 8 then begin
2935 if NotDateorTimeString(stList[i]) then begin
2936 Result := stList[i];
2937 break;
2938 end;
2939 end;
2940 finally
2941 stList.Free;
2942 end;
2943 end;
2944 end;
2945 end;
2946 {!
2947 \brief ??????腮 ID ?????ゃ???鴻???????潟??
2948 \param AID ??篋冴???劫???????腮 ID
2949 \param ThreadItem ?????????鴻??????
2950 \return ???? ID ?????ゃ???鴻????/span>
2951 }
2952 function TGikoSys.GetSameIDResCount(const AID : string; ThreadItem: TThreadItem):Integer;
2953 var
2954 body: TStringList;
2955 begin
2956 Result := 0;
2957 if (not IsNoValidID(AID))
2958 and (ThreadItem <> nil) and (ThreadItem.IsLogFile) then begin
2959 body := TStringList.Create;
2960 try
2961 GetSameIDRes(AID, ThreadItem, body);
2962 Result := body.Count;
2963 finally
2964 body.Free;
2965 end;
2966 end;
2967
2968 end;
2969
2970 {!
2971 \brief ??????腮 ID ?????ゃ???鴻???????潟??
2972 \param AIDNum ??篋冴???劫???????腮 ID
2973 \param ThreadItem ?????????鴻??????
2974 \return ???? ID ?????ゃ???鴻????/span>
2975 }
2976 function TGikoSys.GetSameIDResCount(AIDNum : Integer; ThreadItem: TThreadItem):Integer;
2977 var
2978 body: TStringList;
2979 begin
2980 Result := 0;
2981 if (ThreadItem <> nil) and (ThreadItem.IsLogFile) then begin
2982 body := TStringList.Create;
2983 try
2984 GetSameIDRes(AIDNum, ThreadItem, body);
2985 Result := body.Count;
2986 finally
2987 body.Free;
2988 end;
2989 end;
2990 end;
2991
2992 {!
2993 \brief ???祉??腓冴????絖????с???<??????????
2994 \param AStr 茯帥?鴻????絖???
2995 \return ???祉?с???<?????? True
2996 \todo ???綵?Not)???????膤?Is)
2997 }
2998 function TGikoSys.NotDateorTimeString(const AStr : string): boolean;
2999 begin
3000 Result := false;
3001 try
3002 StrToDate(AStr);
3003 except
3004 try
3005 StrToTime(AStr);
3006 Result := false;
3007 except
3008 Result := true;
3009 end;
3010 end;
3011
3012 end;
3013
3014 {!
3015 \brief ?鴻????:茯??違???????潟??
3016 \param text ??????????腴?
3017 \param wordCount OUT:?????潟??????????茯????荀с??菴???
3018 }
3019 procedure TGikoSys.SpamCountWord( const text : string; wordCount : TWordCount );
3020 begin
3021
3022 if Setting.SpamFilterAlgorithm = gsfaNone then Exit;
3023 Bayesian.CountWord( text, wordCount );
3024
3025 end;
3026
3027 {!
3028 \brief ?鴻????:絖??腟??????丈?
3029 \param wordCount ?丈???????茯????荀?/span>
3030 \param isSpam wordCount ???鴻???????????膺??????????????? True
3031 \warning 絖??羝??帥????腴???????????∈茯??堺?ャ?障??????\n
3032 Learn ????????????腴??? isSpam ????????????絎???????/span>
3033 ???若?帥???若?鴻???贋?????障????\n
3034 絖??羝??帥????????????????????????????????
3035
3036 ???????膺?腟??????????≪????????с???????障??????\n
3037 wordCount ??緇?????腴????膺?腟??????帥?????≪???障????
3038
3039 筝祉???鴻????????????????帥????????? Forget -> Learn ?????т戎?????障????<