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.257 - (show annotations) (download) (as text)
Sun Feb 20 06:47:14 2011 UTC (13 years, 2 months ago) by h677
Branch: MAIN
Changes since 1.256: +31 -2 lines
File MIME type: text/x-pascal
冒険の書のエラーでもCookieを更新
冒険の書を設定画面で削除・設定できるようにした。

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