OSDN Git Service

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