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.104 - (show annotations) (download) (as text)
Tue Dec 9 19:26:51 2003 UTC (20 years, 4 months ago) by h677
Branch: MAIN
Changes since 1.103: +1 -0 lines
File MIME type: text/x-pascal
巡回ファイル関係の修正

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