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.188 - (show annotations) (download) (as text)
Mon Jul 18 03:55:14 2005 UTC (18 years, 9 months ago) by h677
Branch: MAIN
CVS Tags: marged-Bb50
Changes since 1.187: +51 -3 lines
File MIME type: text/x-pascal
ハ゛タ50(1.50.1.599)までの変更分をマージ

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