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