Develop and Download Open Source Software

Browse CVS Repository

Contents of /gikonavigoeson/gikonavi/GikoSystem.pas

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.169 - (show annotations) (download) (as text)
Mon Nov 8 14:38:54 2004 UTC (19 years, 5 months ago) by h677
Branch: MAIN
Changes since 1.168: +36 -2 lines
File MIME type: text/x-pascal
したらばJBBSの同IDレスポップアップに対応

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