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.235 - (show annotations) (download) (as text)
Sun Sep 9 07:11:58 2007 UTC (16 years, 7 months ago) by h677
Branch: MAIN
CVS Tags: v1_57_0_730
Changes since 1.234: +8 -17 lines
File MIME type: text/x-pascal
Settingのメモリリーク修正。
NewBoardURLのメモリリーク修正。
ツールバーのFontがメモリリークする(?)っぽいので微妙な修正追加

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