OSDN Git Service

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