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.131 - (show annotations) (download) (as text)
Mon Apr 26 16:24:25 2004 UTC (19 years, 11 months ago) by h677
Branch: MAIN
Changes since 1.130: +4 -1 lines
File MIME type: text/x-pascal
異常終了後tmpファイルがあるとxxx.datが開けませんエラーがでる不具合の修正

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