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.136 - (show annotations) (download) (as text)
Thu May 6 14:07:37 2004 UTC (19 years, 11 months ago) by h677
Branch: MAIN
Changes since 1.135: +2 -59 lines
File MIME type: text/x-pascal
WriteThreadDatメソッド内でTmpFileListの解放し忘れてたので解放

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