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