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.222 - (show annotations) (download) (as text)
Tue Aug 8 16:49:09 2006 UTC (17 years, 8 months ago) by h677
Branch: MAIN
CVS Tags: v1_54_0_676
Changes since 1.221: +4 -4 lines
File MIME type: text/x-pascal
前回異常終了で残ったtempファイルの処理をメソッド化

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