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.215 - (show annotations) (download) (as text)
Tue Jun 20 15:18:03 2006 UTC (17 years, 10 months ago) by h677
Branch: MAIN
Changes since 1.214: +2 -2 lines
File MIME type: text/x-pascal
バタ52の方の修正分をマージ

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