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.53 - (show annotations) (download) (as text)
Thu Oct 9 13:21:22 2003 UTC (20 years, 6 months ago) by h677
Branch: MAIN
CVS Tags: b43
Changes since 1.52: +1 -1 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
18 type
19 //BBS繧ソ繧、繝?/span>
20 TGikoBBSType = (gbt2ch);
21 //繝ュ繧ー繧ソ繧、繝?/span>
22 TGikoLogType = (glt2chNew, glt2chOld);
23 //繝。繝?そ繝シ繧ク繧「繧、繧ウ繝ウ
24 TGikoMessageIcon = (gmiOK, gmiSAD, gmiNG, gmiWhat, gmiNone);
25 //URL繧ェ繝シ繝励Φ繝悶Λ繧ヲ繧カ繧ソ繧、繝?/span>
26 TGikoBrowserType = (gbtIE, gbtUserApp, gbtAuto);
27
28
29 TStrTokSeparator = set of Char;
30 TStrTokRec = record
31 Str: string;
32 Pos: Integer;
33 end;
34
35 //繧、繝ウ繝?ャ繧ッ繧ケ繝輔ぃ繧、繝ォ繝ャ繧ウ繝シ繝?/span>
36 TIndexRec = record
37 FNo: Integer;
38 FFileName: string;
39 FTitle: string;
40 FCount: Integer;
41 FSize: Integer;
42 // FRoundNo: Integer;
43 FRoundDate: TDateTime;
44 FLastModified: TDateTime;
45 FKokomade: Integer;
46 FNewReceive: Integer;
47 FMishiyou: Boolean; //譛ェ菴ソ逕ィ
48 FUnRead: Boolean;
49 FScrollTop: Integer;
50 //Index Ver 1.01
51 FAllResCount: Integer;
52 FNewResCount: Integer;
53 FAgeSage: TGikoAgeSage;
54 end;
55
56 //繧オ繝悶ず繧ァ繧ッ繝医Ξ繧ウ繝シ繝?/span>
57 TSubjectRec = record
58 FFileName: string;
59 FTitle: string;
60 FCount: Integer;
61 end;
62
63 //繝ャ繧ケ繝ャ繧ウ繝シ繝?/span>
64 TResRec = record
65 FTitle: string;
66 FMailTo: string;
67 FName: string;
68 FDateTime: string;
69 FBody: string;
70 FType: TGikoLogType;
71 end;
72
73 //URLPath繝ャ繧ウ繝シ繝?/span>
74 TPathRec = record
75 FBBS: string; //BBSID
76 FKey: string; //ThreadID
77 FSt: Integer; //髢句ァ九Ξ繧ケ逡ェ
78 FTo: Integer; //邨ゆコ?Ξ繧ケ逡ェ
79 FFirst: Boolean; //>>1縺ョ陦ィ遉コ
80 FStBegin: Boolean; //1縲懆。ィ遉コ
81 FToEnd: Boolean; //縲懈怙蠕後∪縺ァ陦ィ遉コ
82 FDone: Boolean; //謌仙粥
83 end;
84
85 TGikoSys = class(TObject)
86 private
87 { Private 螳」險? }
88 FSetting: TSetting;
89 FDolib: TDolib;
90 FAWKStr: TAWKStr;
91 FOnlyAHundredRes : Boolean;
92 // FExitWrite: TStringList;
93 // function StrToFloatDef(s: string; Default: Double): Double;
94
95 public
96 { Public 螳」險? }
97 FAbon : TAbon;
98 FSelectResFilter : TAbon;
99 constructor Create;
100
101 destructor Destroy; override;
102 property OnlyAHundredRes : Boolean read FOnlyAHundredRes write FOnlyAHundredRes;
103
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 GetURL(BBSID: string; FileName: string): string;
129 function GetUserAgent: 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; List: TStringList; SubDir: Boolean; IsPathAdd: Boolean);
136 procedure GetDirectoryList(Path: string; Mask: string; List: TStringList; SubDir: Boolean);
137
138 procedure CreateHTML2(doc: Variant; ThreadItem: TThreadItem; var sTitle: string);
139 function AddAnchorTag(s: string): string;
140
141 function DivideSubject(Line: string): TSubjectRec;
142 function DivideStrLine(Line: string): TResRec;
143
144 property Setting: TSetting read FSetting write FSetting;
145 property Dolib: TDolib read FDolib write FDolib;
146
147 function UrlToID(url: string): string;
148 function UrlToServer(url: string): string;
149
150 function StrTokFirst(const s:string; const sep:TStrTokSeparator; var Rec:TStrTokRec):string;
151 function StrTokNext(const sep:TStrTokSeparator; var Rec:TStrTokRec): string;
152
153 function GetFileSize(FileName : string) : longint;
154 function GetFileLineCount(FileName : string): longint;
155 function Get2chDate(aDate: TDateTime): string;
156 function IntToDateTime(val: Int64): TDateTime;
157 function DateTimeToInt(ADate: TDateTime): Integer;
158
159 function ReadThreadFile(FileName: string; Line: Integer): string;
160
161 procedure MenuFont(Font: TFont);
162
163 function RemoveToken(var s:string;delimiter:string):string;
164 function GetTokenIndex(s: string; delimiter: string; index: Integer): string;
165
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;
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
188 // 繧ケ繧ュ繝ウ繧定ェュ縺ソ霎シ縺ソ縲∝?、繧堤スョ謠帙☆繧?/span>
189 function LoadFromSkin( fileName: string; ThreadItem: TThreadItem; sTitle: string; SizeByte: Integer ): string;
190 // 繝ャ繧ケ縺ョ蛟、繧堤スョ謠帙☆繧?/span>
191 function SkinedRes( skin: string; Res: TResRec; No: string ): string;
192
193 end;
194
195 var
196 GikoSys: TGikoSys;
197 const
198 LENGTH_RESTITLE = 40;
199 ZERO_DATE: Integer = 25569;
200 BETA_VERSION_NAME_E = 'beta';
201 BETA_VERSION_NAME_J = '?奇セ橸セ?';
202 BETA_VERSION = 43;
203 BETA_VERSION_BUILD = ''; //debug迚医↑縺ゥ
204
205 implementation
206
207 uses
208 Giko, RoundData;
209
210 const
211 BOARD_FILE_NAME = 'board.2ch';
212 CUSTOMBOARD_FILE_NAME = 'custom.2ch';
213 KEY_SETTING_FILE_NAME = 'key.ini';
214 TEMP_FOLDER = 'Temp';
215 OUTBOX_FILE_NAME = 'outbox.ini';
216 SENT_FILE_NAME = 'sent.ini';
217 CONFIG_DIR_NAME = 'config';
218 CSS_DIR_NAME = 'css';
219 SKIN_DIR_NAME = 'skin';
220 SKIN_HEADER_FILE_NAME = 'Header.html';
221 SKIN_FOOTER_FILE_NAME = 'Footer.html';
222 SKIN_NEWRES_FILE_NAME = 'NewRes.html';
223 SKIN_RES_FILE_NAME = 'Res.html';
224 SKIN_BOOKMARK_FILE_NAME = 'Bookmark.html';
225 SKIN_NEWMARK_FILE_NAME = 'Newmark.html';
226 FOLDER_INDEX_VERSION = '1.01';
227 USER_AGENT = 'Monazilla';
228 APP_NAME = 'gikoNavi';
229 DEFAULT_NGWORD_FILE_NAME : String = 'NGword.txt';
230 NGWORDs_DIR_NAME : String = 'NGwords';
231
232 (*************************************************************************
233 *GikoSys繧ウ繝ウ繧ケ繝医Λ繧ッ繧ソ
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 // 邨槭j霎シ繧?縺ィ縺阪?讌オ蜉帑ク?隕ァ縺瑚ヲ九i繧後k縺サ縺?′縺?>縺ョ縺ァ莉悶?螳悟?縺ォ蜑企勁
254 FSelectResFilter.AbonString := '';
255 //
256 OnlyAHundredRes := FSetting.OnlyAHundredRes;
257 end;
258
259 (*************************************************************************
260 *GikoSys繝?せ繝医Λ繧ッ繧ソ
261 *************************************************************************)
262 destructor TGikoSys.Destroy;
263 var
264 i: Integer;
265 FileList: TStringList;
266 begin
267 //繧ケ繝ャ繝?ラ繝??繧ソ繝輔ぃ繧、繝ォ繧呈峩譁ー
268 // FlashExitWrite;
269
270 // FExitWrite.Free;
271 FAWKStr.Free;
272 FSetting.Free;
273 FDolib.Free;
274
275 //繝?Φ繝昴Λ繝ェHTML繧貞炎髯、
276 FileList := TStringList.Create;
277 try
278 GetFileList(GetTempFolder, '*.html', FileList, False, True);
279 for i := 0 to FileList.Count - 1 do begin
280 DeleteFile(FileList[i]);
281 end;
282 finally
283 FileList.Free;
284 end;
285 inherited;
286 end;
287
288 (*************************************************************************
289 *譁?ュ怜?謨ー蟄励メ繧ァ繝?け
290 *************************************************************************)
291 {$HINTS OFF}
292 function TGikoSys.IsNumeric(s: string): boolean;
293 var
294 e: integer;
295 v: integer;
296 begin
297 Val(s, v, e);
298 Result := e = 0;
299 end;
300 {$HINTS ON}
301
302 (*************************************************************************
303 *譁?ュ怜?豬ョ蜍募ー乗焚轤ケ謨ー蟄励メ繧ァ繝?け
304 *************************************************************************)
305 function TGikoSys.IsFloat(s: string): boolean;
306 var
307 v: Extended;
308 begin
309 Result := TextToFloat(PChar(s), v, fvExtended);
310 end;
311
312 (*************************************************************************
313 *繝懊?繝峨ヵ繧。繧、繝ォ蜷榊叙蠕暦シ医ヱ繧ケ?九ヵ繧。繧、繝ォ蜷搾シ?/span>
314 *************************************************************************)
315 function TGikoSys.GetBoardFileName: string;
316 begin
317 Result := GetAppDir + CONFIG_DIR_NAME + '\' + BOARD_FILE_NAME;
318 end;
319
320 (*************************************************************************
321 *繝懊?繝峨ヵ繧。繧、繝ォ蜷榊叙蠕暦シ医ヱ繧ケ?九ヵ繧。繧、繝ォ蜷搾シ?/span>
322 *************************************************************************)
323 function TGikoSys.GetCustomBoardFileName: string;
324 begin
325 Result := GetAppDir + CONFIG_DIR_NAME + '\' + CUSTOMBOARD_FILE_NAME;
326 end;
327
328 (*************************************************************************
329 *繝?Φ繝昴Λ繝ェ繝輔か繝ォ繝?繝シ蜷榊叙蠕?/span>
330 *************************************************************************)
331 function TGikoSys.GetHtmlTempFileName: string;
332 begin
333 Result := TEMP_FOLDER;
334 end;
335
336
337 (*************************************************************************
338 *螳溯。後ヵ繧。繧、繝ォ繝輔か繝ォ繝?蜿門セ?/span>
339 *************************************************************************)
340 function TGikoSys.GetAppDir: string;
341 begin
342 Result := ExtractFilePath(Application.ExeName);
343 end;
344
345 (*************************************************************************
346 *TempHtml繝輔ぃ繧、繝ォ蜷榊叙蠕暦シ医ヱ繧ケ?九ヵ繧。繧、繝ォ蜷搾シ?/span>
347 *************************************************************************)
348 function TGikoSys.GetTempFolder: string;
349 begin
350 Result := GetAppDir + TEMP_FOLDER;
351 end;
352
353 (*************************************************************************
354 *sent.ini繝輔ぃ繧、繝ォ蜷榊叙蠕暦シ医ヱ繧ケ?九ヵ繧。繧、繝ォ蜷搾シ?/span>
355 *************************************************************************)
356 function TGikoSys.GetSentFileName: string;
357 begin
358 Result := GetAppDir + SENT_FILE_NAME;
359 end;
360
361 (*************************************************************************
362 *outbox.ini繝輔ぃ繧、繝ォ蜷榊叙蠕暦シ医ヱ繧ケ?九ヵ繧。繧、繝ォ蜷搾シ?/span>
363 *************************************************************************)
364 function TGikoSys.GetOutBoxFileName: string;
365 begin
366 Result := GetAppDir + OUTBOX_FILE_NAME;
367 end;
368
369 (*************************************************************************
370 *Config繝輔か繝ォ繝?蜿門セ?/span>
371 *************************************************************************)
372 function TGikoSys.GetConfigDir: string;
373 begin
374 Result := IncludeTrailingPathDelimiter(GetAppDir + CONFIG_DIR_NAME);
375 end;
376
377 function TGikoSys.GetStyleSheetDir: string;
378 begin
379 Result := IncludeTrailingPathDelimiter(GetConfigDir + CSS_DIR_NAME);
380 end;
381
382 function TGikoSys.GetSkinDir: string;
383 begin
384 Result := IncludeTrailingPathDelimiter(GetConfigDir + SKIN_DIR_NAME);
385 end;
386
387 function TGikoSys.GetSkinHeaderFileName: string;
388 begin
389 Result := Setting.CSSFileName + SKIN_HEADER_FILE_NAME;
390 end;
391
392 function TGikoSys.GetSkinFooterFileName: string;
393 begin
394 Result := Setting.CSSFileName + SKIN_FOOTER_FILE_NAME;
395 end;
396
397 function TGikoSys.GetSkinNewResFileName: string;
398 begin
399 Result := Setting.CSSFileName + SKIN_NEWRES_FILE_NAME;
400 end;
401
402 function TGikoSys.GetSkinResFileName: string;
403 begin
404 Result := Setting.CSSFileName + SKIN_RES_FILE_NAME;
405 end;
406
407 function TGikoSys.GetSkinBookmarkFileName: string;
408 begin
409 Result := Setting.CSSFileName + SKIN_BOOKMARK_FILE_NAME;
410 end;
411
412 function TGikoSys.GetSkinNewmarkFileName: string;
413 begin
414 Result := Setting.CSSFileName + SKIN_NEWMARK_FILE_NAME;
415 end;
416
417 (*************************************************************************
418 *URL繧剃ス懈?(繧ウ繝斐?逕ィ)
419 *************************************************************************)
420 function TGikoSys.GetURL(BBSID: string; FileName: string): string;
421 var
422 Board: TBoard;
423 begin
424 Board := BoardGroup.BBS2ch.GetBoardFromBBSID(BBSID);
425 Result := UrlToServer(Board.URL) + 'test/read.cgi/' + UrlToID(Board.URL) + '/' + ChangeFileExt(FileName, '') + '/l50';
426 //http://teri.2ch.net/test/read.cgi?bbs=accuse&key=974619522&ls=50
427 //http://pc.2ch.net/test/read.cgi/tech/1003664165/l50
428 end;
429
430 // UserAgent蜿門セ?/span>
431 function TGikoSys.GetUserAgent: string;
432 begin
433 if Dolib.Connected then begin
434 Result := Format('%s %s/%s%d%s', [
435 Dolib.UserAgent,
436 APP_NAME,
437 //MAJOR_VERSION,
438 //MINOR_VERSION,
439 BETA_VERSION_NAME_E,
440 BETA_VERSION,
441 BETA_VERSION_BUILD]);
442 end else begin
443 Result := Format('%s/%s %s/%s%d%s', [
444 USER_AGENT,
445 Dolib.Version,
446 APP_NAME,
447 //MAJOR_VERSION,
448 //MINOR_VERSION,
449 BETA_VERSION_NAME_E,
450 BETA_VERSION,
451 BETA_VERSION_BUILD]);
452 end;
453 end;
454
455 (*************************************************************************
456 *?偵■繧?s縺ュ繧区婿蠑乗凾蛻サ蜿門セ?/span>
457 *************************************************************************)
458 function TGikoSys.Get2chDate(aDate: TDateTime): string;
459 var
460 d1: TDateTime;
461 d2: TDateTime;
462 begin
463 d1 := EncodeDate(1970, 1, 1);
464 d2 := aDate - EncodeTime(9, 0, 0, 0);
465 Result := FloatToStr(Trunc((d2 - d1) * 24 * 60 * 60));
466 end;
467
468
469 function TGikoSys.IntToDateTime(val: Int64): TDateTime;
470 var
471 d1: tdatetime;
472 d2: tdatetime;
473 begin
474 d1 := EncodeDate(1970, 1, 1);
475 d2 := (val * 1000) / (24 * 60 * 60 * 1000);
476 Result := d1 + d2;
477 end;
478
479 function TGikoSys.DateTimeToInt(ADate: TDateTime): Integer;
480 var
481 d: TDateTime;
482 c: Currency;
483 begin
484 d := EncodeDate(1970, 1, 1);
485 c := (ADate - d) * 24 * 60 * 60;
486 Result := Trunc(c);
487 end;
488
489
490 (*************************************************************************
491 *Subject繝輔ぃ繧、繝ォRead
492 *************************************************************************)
493 procedure TGikoSys.ReadSubjectFile(Board: TBoard);
494 var
495 ThreadItem: TThreadItem;
496 FileName: string;
497 FileList: TStringList;
498 TmpFileList: TStringList;
499 // SrchRec: TSearchRec;
500 // R: integer;
501 Index: Integer;
502 sl: TStringList;
503 i: Integer;
504 Rec: TIndexRec;
505 UnRead: Integer;
506 // TmpUpdate: Boolean;
507 ini: TMemIniFile;
508 ResRec: TResRec;
509 RoundItem: TRoundItem;
510 idx: Integer;
511 begin
512 Board.Clear;
513 UnRead := 0;
514 // TmpUpdate := False;
515
516 FileName := Board.GetFolderIndexFileName;
517 if not FileExists(FileName) then CreateThreadDat(Board);
518 // if not FileExists(FileName) then Exit;
519
520 //IsLogFile逕ィDAT繝輔ぃ繧、繝ォ繝ェ繧ケ繝?/span>
521 FileList := TStringList.Create;
522 FileList.Sorted := True;
523 GetFileList(ExtractFileDir(Board.GetFolderIndexFileName), '*.dat', FileList, False, False);
524
525 //蜑榊屓逡ー蟶ク邨ゆコ?凾逕ィTmp繝輔ぃ繧、繝ォ繝ェ繧ケ繝?/span>
526 TmpFileList := TStringList.Create;
527 TmpFileList.Sorted := True;
528 GetFileList(ExtractFileDir(Board.GetFolderIndexFileName), '*.tmp', TmpFileList, False, False);
529
530 { R := FindFirst(ExtractFileDir(Board.GetFolderIndexFileName) + '\*.dat', 0, SrchRec);
531 while R = 0 do begin
532 FileList.Add(SrchRec.Name);
533 R := FindNext(SrchRec);
534 end;
535 FindClose(SrchRec);}
536
537 sl := TStringList.Create;
538 try
539 if FileExists(FileName) then
540 sl.LoadFromFile(FileName);
541
542 //?定。檎岼縺九i?茨シ題。檎岼縺ッ繝舌?繧ク繝ァ繝ウ??/span>
543 for i := 1 to sl.Count - 1 do begin
544 Rec := ParseIndexLine(sl[i]);
545
546 ThreadItem := TThreadItem.Create;
547 ThreadItem.BeginUpdate;
548 ThreadItem.No := Rec.FNo;
549 ThreadItem.FileName := Rec.FFileName;
550 ThreadItem.Title := Rec.FTitle;
551 ThreadItem.Count := Rec.FCount;
552 ThreadItem.Size := Rec.FSize;
553 // ThreadItem.RoundNo := Rec.FRoundNo;
554 ThreadItem.RoundDate := Rec.FRoundDate;
555 ThreadItem.LastModified := Rec.FLastModified;
556 ThreadItem.Kokomade := Rec.FKokomade;
557 ThreadItem.NewReceive := Rec.FNewReceive;
558 // ThreadItem.Round := Rec.FRound;
559 ThreadItem.UnRead := Rec.FUnRead;
560 ThreadItem.ScrollTop := Rec.FScrollTop;
561 ThreadItem.AllResCount := Rec.FAllResCount;
562 ThreadItem.NewResCount := Rec.FNewResCount;
563 ThreadItem.AgeSage := Rec.FAgeSage;
564 ThreadItem.ParentBoard := Board;
565
566 //IsLogFile繝√ぉ繝?け
567 ThreadItem.IsLogFile := False;
568 if FileList.Count <> 0 then begin
569 if FileList.Find(ThreadItem.FileName, Index) then begin
570 ThreadItem.IsLogFile := True;
571 FileList.Delete(Index);
572 end;
573 end;
574
575 //蟾。蝗槭Μ繧ケ繝医↓蟄伜惠縺励◆繧牙キ。蝗槭ヵ繝ゥ繧ー繧サ繝?ヨ
576 if ThreadItem.IsLogFile then begin
577 idx := RoundList.Find(ThreadItem);
578 if idx <> -1 then begin
579 RoundItem := RoundList.Items[idx, grtItem];
580 ThreadItem.RoundName := RoundItem.RoundName;
581 ThreadItem.Round := True;
582 end;
583 end;
584
585 //蜑榊屓逡ー蟶ク邨ゆコ?凾繝√ぉ繝?け
586 if TmpFileList.Count <> 0 then begin
587 if TmpFileList.Find(ChangeFileExt(ThreadItem.FileName, '.tmp'), Index) then begin
588 ini := TMemIniFile.Create(ChangeFileExt(ThreadItem.GetThreadFileName, '.tmp'));
589 try
590 ThreadItem.RoundDate := ini.ReadDateTime('Setting', 'RoundDate', ZERO_DATE);
591 ThreadItem.LastModified := ini.ReadDateTime('Setting', 'LastModified', ZERO_DATE);
592 ThreadItem.Size := ini.ReadInteger('Setting', 'Size', 0);
593 ThreadItem.Count := ini.ReadInteger('Setting', 'Count', 0);
594 ThreadItem.NewReceive := ini.ReadInteger('Setting', 'NewReceive', 0);
595 ThreadItem.Round := ini.ReadBool('Setting', 'Round', False);
596 ThreadItem.UnRead := False;//ini.ReadBool('Setting', 'UnRead', False);
597 ThreadItem.ScrollTop := ini.ReadInteger('Setting', 'ScrollTop', 0);
598 ThreadItem.AllResCount := ini.ReadInteger('Setting', 'AllResCount', 0);
599 ThreadItem.NewResCount := ini.ReadInteger('Setting', 'NewResCount', 0);
600 ThreadItem.AgeSage := TGikoAgeSage(ini.ReadInteger('Setting', 'AgeSage', Ord(gasNone)));
601 finally
602 ini.Free;
603 end;
604 TmpFileList.Delete(Index);
605 end;
606 end;
607
608 ThreadItem.EndUpdate;
609 Board.Add(ThreadItem);
610
611 // if (ThreadItem.IsLogFile) and (ThreadItem.Count > ThreadItem.Kokomade) then
612 if (ThreadItem.IsLogFile) and (ThreadItem.UnRead) then
613 Inc(UnRead);
614 end;
615 if UnRead <> Board.UnRead then
616 Board.UnRead := UnRead;
617
618 //繧、繝ウ繝?ャ繧ッ繧ケ縺ォ辟。縺九▲縺溘Ο繧ー繧定ソス蜉??郁?繧後う繝ウ繝?ャ繧ッ繧ケ蟇セ蠢懶シ?/span>
619 for i := 0 to FileList.Count - 1 do begin
620 FileName := ExtractFileDir(Board.GetFolderIndexFileName) + '\' + FileList[i];
621
622 ResRec := DivideStrLine(ReadThreadFile(FileName, 1));
623 ThreadItem := TThreadItem.Create;
624 ThreadItem.No := Board.Count + 1;
625 ThreadItem.FileName := FileList[i];
626 ThreadItem.Title := ResRec.FTitle;
627 ThreadItem.Count := GetFileLineCount(FileName);
628 ThreadItem.AllResCount := ThreadItem.Count;
629 ThreadItem.NewResCount := 0;
630 ThreadItem.Size := 0;
631 ThreadItem.RoundDate := ZERO_DATE;
632 ThreadItem.LastModified := ZERO_DATE;
633 ThreadItem.Kokomade := -1;
634 ThreadItem.NewReceive := 0;
635 ThreadItem.ParentBoard := Board;
636 ThreadItem.IsLogFile := True;
637 ThreadItem.Round := False;
638 ThreadItem.UnRead := False;
639 ThreadItem.ScrollTop := 0;
640 ThreadItem.AgeSage := gasNone;
641 Board.Add(ThreadItem);
642 end;
643 finally
644 sl.Free;
645 end;
646 FileList.Free;
647 TmpFileList.Free;
648 Board.IsThreadDatRead := True;
649 end;
650
651 (*************************************************************************
652 *繧ケ繝ャ繝?ラ繧、繝ウ繝?ャ繧ッ繧ケ繝輔ぃ繧、繝ォ(Folder.idx)菴懈?
653 *************************************************************************)
654 procedure TGikoSys.CreateThreadDat(Board: TBoard);
655 var
656 i: integer;
657 s: string;
658 SubjectList: TStringList;
659 sl: TStringList;
660 Rec: TSubjectRec;
661 FileName: string;
662 cnt: Integer;
663 begin
664 if not FileExists(Board.GetSubjectFileName) then Exit;
665 FileName := Board.GetFolderIndexFileName;
666
667 SubjectList := TStringList.Create;
668 try
669 SubjectList.LoadFromFile(Board.GetSubjectFileName);
670 sl := TStringList.Create;
671 try
672 cnt := 1;
673 sl.Add(FOLDER_INDEX_VERSION);
674 for i := 0 to SubjectList.Count - 1 do begin
675 Rec := DivideSubject(SubjectList[i]);
676
677 if (Trim(Rec.FFileName) = '') or (Trim(Rec.FTitle) = '') then
678 Continue;
679
680 s := Format('%x', [cnt]) + #1 //逡ェ蜿キ
681 + Rec.FFileName + #1 //繝輔ぃ繧、繝ォ蜷?/span>
682 + Rec.FTitle + #1 //繧ソ繧、繝医Ν
683 + Format('%x', [Rec.FCount]) + #1 //繧ォ繧ヲ繝ウ繝?/span>
684 + Format('%x', [0]) + #1 //size
685 + Format('%x', [0]) + #1 //RoundDate
686 + Format('%x', [0]) + #1 //LastModified
687 + Format('%x', [0]) + #1 //Kokomade
688 + Format('%x', [0]) + #1 //NewReceive
689 + '0' + #1 //譛ェ菴ソ逕ィ
690 + Format('%x', [0]) + #1 //UnRead
691 + Format('%x', [0]) + #1 //ScrollTop
692 + Format('%x', [Rec.FCount]) + #1 //AllResCount
693 + Format('%x', [0]) + #1 //NewResCount
694 + Format('%x', [0]); //AgeSage
695
696 sl.Add(s);
697 inc(cnt);
698 end;
699 sl.SaveToFile(FileName);
700 finally
701 sl.Free;
702 end;
703 finally
704 SubjectList.Free;
705 end;
706 end;
707
708 (*************************************************************************
709 *繧ケ繝ャ繝?ラ繧、繝ウ繝?ャ繧ッ繧ケ(Thread.dat)譖ク縺崎セシ縺ソ
710 *Public
711 *************************************************************************)
712 procedure TGikoSys.WriteThreadDat(Board: TBoard);
713 //const
714 // Values: array[Boolean] of string = ('0', '1');
715 var
716 i: integer;
717 FileName: string;
718 sl: TStringList;
719 s: string;
720 FileList: TStringList;
721 begin
722 if not Board.IsThreadDatRead then
723 Exit;
724 FileName := Board.GetFolderIndexFileName;
725 ForceDirectoriesEx(Board.ParentCategory.ParentBBS2ch.GetLogFolder + Board.BBSID);
726
727 sl := TStringList.Create;
728 try
729 sl.Add(FOLDER_INDEX_VERSION);
730 for i := 0 to Board.Count - 1 do begin
731 if Board.Items[i].No = 0 then
732 Board.Items[i].No := i + 1;
733
734 s := Format('%x', [Board.Items[i].No]) + #1
735 + Board.Items[i].FileName + #1
736 + Board.Items[i].Title + #1
737 + Format('%x', [Board.Items[i].Count]) + #1
738 + Format('%x', [Board.Items[i].Size]) + #1
739 + Format('%x', [DateTimeToInt(Board.Items[i].RoundDate)]) + #1
740 + Format('%x', [DateTimeToInt(Board.Items[i].LastModified)]) + #1
741 + Format('%x', [Board.Items[i].Kokomade]) + #1
742 + Format('%x', [Board.Items[i].NewReceive]) + #1
743 + '0' + #1 //譛ェ菴ソ逕ィ
744 + Format('%x', [BoolToInt(Board.Items[i].UnRead)]) + #1
745 + Format('%x', [Board.Items[i].ScrollTop]) + #1
746 + Format('%x', [Board.Items[i].AllResCount]) + #1
747 + Format('%x', [Board.Items[i].NewResCount]) + #1
748 + Format('%x', [Ord(Board.Items[i].AgeSage)]);
749
750 sl.Add(s);
751 end;
752
753 sl.SaveToFile(FileName);
754
755 FileList := TStringList.Create;
756 try
757 GetFileList(ExtractFileDir(Board.GetFolderIndexFileName), '*.tmp', FileList, False, True);
758 for i := 0 to FileList.Count - 1 do begin
759 DeleteFile(FileList[i]);
760 end;
761 finally
762 FileList.Free;
763 end;
764 finally
765 sl.Free;
766 end;
767 end;
768
769 function TGikoSys.ParseIndexLine(Line: string): TIndexRec;
770 var
771 s: string;
772 i: Integer;
773 begin
774 for i := 0 to 14 do begin
775 s := GetTokenIndex(Line, #1, i);
776 case i of
777 0: Result.FNo := StrToIntDef('$' + s, 0);
778 1: Result.FFileName := s;
779 2: Result.FTitle := s;
780 3: Result.FCount := StrToIntDef('$' + s, 0);
781 4: Result.FSize := StrToIntDef('$' + s, 0);
782 5: Result.FRoundDate := IntToDateTime(StrToIntDef('$' + s, ZERO_DATE));
783 6: Result.FLastModified := IntToDateTime(StrToIntDef('$' + s, ZERO_DATE));
784 7: Result.FKokomade := StrToIntDef('$' + s, -1);
785 8: Result.FNewReceive := StrToIntDef('$' + s, 0);
786 9: ; //譛ェ菴ソ逕ィ
787 10: Result.FUnRead := IntToBool(StrToIntDef('$' + s, 0));
788 11: Result.FScrollTop := StrToIntDef('$' + s, 0);
789 12: Result.FAllResCount := StrToIntDef('$' + s, 0);
790 13: Result.FNewResCount := StrToIntDef('$' + s, 0);
791 14: Result.FAgeSage := TGikoAgeSage(StrToIntDef('$' + s, 0));
792 end;
793 end;
794 end;
795
796 //謖?ョ壹ヵ繧ゥ繝ォ繝?蜀??謖?ョ壹ヵ繧。繧、繝ォ荳?隕ァ繧貞叙蠕励☆繧?/span>
797 // ListFiles('c:\', '*.txt', list, True);
798 procedure TGikoSys.GetFileList(Path: string; Mask: string; List: TStringList; SubDir: Boolean; IsPathAdd: Boolean);
799 var
800 rc: Integer;
801 SearchRec : TSearchRec;
802 s: string;
803 begin
804 Path := IncludeTrailingPathDelimiter(Path);
805 rc := FindFirst(Path + '*.*', faAnyfile, SearchRec);
806 try
807 while rc = 0 do begin
808 if (SearchRec.Name <> '..') and (SearchRec.Name <> '.') then begin
809 s := Path + SearchRec.Name;
810 //if (SearchRec.Attr and faDirectory > 0) then
811 // s := IncludeTrailingPathDelimiter(s)
812
813 if (SearchRec.Attr and faDirectory = 0) and (MatchesMask(s, Mask)) then
814 if IsPathAdd then
815 List.Add(s)
816 else
817 List.Add(SearchRec.Name);
818 if SubDir and (SearchRec.Attr and faDirectory > 0) then
819 GetFileList(s, Mask, List, True, IsPathAdd);
820 end;
821 rc := FindNext(SearchRec);
822 end;
823 finally
824 SysUtils.FindClose(SearchRec);
825 end;
826 end;
827
828 //謖?ョ壹ヵ繧ゥ繝ォ繝?蜀??繝?ぅ繝ャ繧ッ繝医Μ荳?隕ァ繧貞叙蠕励☆繧?/span>
829 procedure TGikoSys.GetDirectoryList(Path: string; Mask: string; List: TStringList; SubDir: Boolean);
830 var
831 rc: Integer;
832 SearchRec : TSearchRec;
833 s: string;
834 begin
835 Path := IncludeTrailingPathDelimiter(Path);
836 rc := FindFirst(Path + '*.*', faDirectory, SearchRec);
837 try
838 while rc = 0 do begin
839 if (SearchRec.Name <> '..') and (SearchRec.Name <> '.') then begin
840 s := Path + SearchRec.Name;
841 //if (SearchRec.Attr and faDirectory > 0) then
842 // s := IncludeTrailingPathDelimiter(s)
843
844 if (SearchRec.Attr and faDirectory > 0) and (MatchesMask(s, Mask)) then
845 List.Add( IncludeTrailingPathDelimiter( s ) );
846 if SubDir and (SearchRec.Attr and faDirectory > 0) then
847 GetDirectoryList(s, Mask, List, True);
848 end;
849 rc := FindNext(SearchRec);
850 end;
851 finally
852 SysUtils.FindClose(SearchRec);
853 end;
854 end;
855
856 // 繧ケ繧ュ繝ウ繧定ェュ縺ソ霎シ縺ソ縲∝?、繧堤スョ謠帙☆繧?/span>
857 function TGikoSys.LoadFromSkin(
858 fileName: string;
859 ThreadItem: TThreadItem;
860 sTitle: string;
861 SizeByte: Integer
862 ): string;
863 var
864 Skin: TStringList;
865 begin
866
867 Skin := TStringList.Create;
868 try
869 if FileExists( fileName) then begin
870 Skin.LoadFromFile( fileName );
871
872 // 繧?j縺九◆縺瑚協縺励>縺代←縲√が繝励す繝ァ繝ウ繝?繧、繧「繝ュ繧ー縺ョ繝励Ξ繝薙Η繝シ逕ィ try
873 try
874 if ThreadItem.ParentBoard.ParentCategory <> nil then
875 Skin.Text := StringReplace( Skin.Text, '<BBSNAME/>', ThreadItem.ParentBoard.ParentCategory.ParentBBS2ch.Title, [rfReplaceAll] );
876 if ThreadItem.ParentBoard.BBSID <> '' then
877 Skin.Text := StringReplace( Skin.Text, '<THREADURL/>', GikoSys.GetURL(ThreadItem.ParentBoard.BBSID, ThreadItem.FileName), [rfReplaceAll] );
878 except end;
879 Skin.Text := StringReplace( Skin.Text, '<BOARDNAME/>', ThreadItem.ParentBoard.Title, [rfReplaceAll] );
880 Skin.Text := StringReplace( Skin.Text, '<BOARDURL/>', ThreadItem.ParentBoard.URL, [rfReplaceAll] );
881 Skin.Text := StringReplace( Skin.Text, '<THREADNAME/>', sTitle, [rfReplaceAll] );
882 Skin.Text := StringReplace( Skin.Text, '<SKINPATH/>', Setting.CSSFileName, [rfReplaceAll] );
883 Skin.Text := StringReplace( Skin.Text, '<GETRESCOUNT/>', IntToStr( ThreadItem.NewReceive - 1 ), [rfReplaceAll] );
884 Skin.Text := StringReplace( Skin.Text, '<NEWRESCOUNT/>', IntToStr( ThreadItem.NewResCount ), [rfReplaceAll] );
885 Skin.Text := StringReplace( Skin.Text, '<ALLRESCOUNT/>', IntToStr( ThreadItem.AllResCount ), [rfReplaceAll] );
886
887 Skin.Text := StringReplace( Skin.Text, '<NEWDATE/>',
888 FormatDateTime('yyyy/mm/dd(ddd) hh:mm', ThreadItem.RoundDate), [rfReplaceAll] );
889 Skin.Text := StringReplace( Skin.Text, '<SIZEKB/>', IntToStr( Floor( SizeByte / 1024 ) ), [rfReplaceAll] );
890 Skin.Text := StringReplace( Skin.Text, '<SIZE/>', IntToStr( SizeByte ), [rfReplaceAll] );
891
892 //----- 縺ィ繧翫≠縺医★縺九■繧??懊@繧?コ呈鋤逕ィ縲ゅさ繝。繝ウ繝医い繧ヲ繝医@縺ヲ繧ゅh縺?/span>
893 // 繧?j縺九◆縺瑚協縺励>縺代←縲√が繝励す繝ァ繝ウ繝?繧、繧「繝ュ繧ー縺ョ繝励Ξ繝薙Η繝シ逕ィ try
894 try
895 if ThreadItem.ParentBoard.ParentCategory <> nil then
896 Skin.Text := StringReplace( Skin.Text, '&BBSNAME', ThreadItem.ParentBoard.ParentCategory.ParentBBS2ch.Title, [rfReplaceAll] );
897 if ThreadItem.ParentBoard.BBSID <> '' then
898 Skin.Text := StringReplace( Skin.Text, '&THREADURL', GikoSys.GetURL(ThreadItem.ParentBoard.BBSID, ThreadItem.FileName), [rfReplaceAll] );
899 except end;
900 Skin.Text := StringReplace( Skin.Text, '&BOARDNAME', ThreadItem.ParentBoard.Title, [rfReplaceAll] );
901 Skin.Text := StringReplace( Skin.Text, '&BOARDURL', ThreadItem.ParentBoard.URL, [rfReplaceAll] );
902 Skin.Text := StringReplace( Skin.Text, '&THREADNAME', sTitle, [rfReplaceAll] );
903 Skin.Text := StringReplace( Skin.Text, '&SKINPATH', Setting.CSSFileName, [rfReplaceAll] );
904 Skin.Text := StringReplace( Skin.Text, '&GETRESCOUNT', IntToStr( ThreadItem.NewReceive - 1 ), [rfReplaceAll] );
905 Skin.Text := StringReplace( Skin.Text, '&NEWRESCOUNT', IntToStr( ThreadItem.NewResCount ), [rfReplaceAll] );
906 Skin.Text := StringReplace( Skin.Text, '&ALLRESCOUNT', IntToStr( ThreadItem.AllResCount ), [rfReplaceAll] );
907
908 Skin.Text := StringReplace( Skin.Text, '&NEWDATE',
909 FormatDateTime('yyyy/mm/dd(ddd) hh:mm', ThreadItem.RoundDate), [rfReplaceAll] );
910 Skin.Text := StringReplace( Skin.Text, '&SIZEKB', IntToStr( Floor( SizeByte / 1024 ) ), [rfReplaceAll] );
911 Skin.Text := StringReplace( Skin.Text, '&SIZE', IntToStr( SizeByte ), [rfReplaceAll] );
912 //----- 縺薙%縺セ縺ァ
913 end;
914 Result := Skin.Text;
915 finally
916 Skin.Free;
917 end;
918 end;
919
920 // 繝ャ繧ケ縺ョ蛟、繧堤スョ謠帙☆繧?/span>
921 function TGikoSys.SkinedRes(
922 skin: string;
923 Res: TResRec;
924 No: string
925 ): string;
926 begin
927
928 try
929 Skin := StringReplace( Skin, '<NUMBER/>',
930 '<a href="menu:' + No + '" name="' + No + '">' + No + '</a>', [rfReplaceAll] );
931 Skin := StringReplace( Skin, '<PLAINNUMBER/>', No, [rfReplaceAll] );
932 Skin := StringReplace( Skin, '<NAME/>', '<b>' + Res.FName + '</b>', [rfReplaceAll] );
933 Skin := StringReplace( Skin, '<MAILNAME/>',
934 '<a href="mailo:' + Res.FMailTo + '"><b>' + Res.FName + '</b></a>', [rfReplaceAll] );
935 Skin := StringReplace( Skin, '<MAIL/>', Res.FMailTo, [rfReplaceAll] );
936 Skin := StringReplace( Skin, '<DATE/>', Res.FDateTime, [rfReplaceAll] );
937 Skin := StringReplace( Skin, '<MESSAGE/>', Res.FBody, [rfReplaceAll] );
938
939 //----- 縺九■繧??懊@繧?コ呈鋤逕ィ縲ゅさ繝。繝ウ繝医い繧ヲ繝医@縺ヲ繧ゅh縺?/span>
940 Skin := StringReplace( Skin, '&NUMBER',
941 '<a href="menu:' + No + '" name="' + No + '">' + No + '</a>', [rfReplaceAll] );
942 Skin := StringReplace( Skin, '&PLAINNUMBER', No, [rfReplaceAll] );
943 Skin := StringReplace( Skin, '&NAME', '<b>' + Res.FName + '</b>', [rfReplaceAll] );
944 Skin := StringReplace( Skin, '&MAILNAME',
945 '<a href="mailo:' + Res.FMailTo + '"><b>' + Res.FName + '</b></a>', [rfReplaceAll] );
946 Skin := StringReplace( Skin, '&MAIL', Res.FMailTo, [rfReplaceAll] );
947 Skin := StringReplace( Skin, '&DATE', Res.FDateTime, [rfReplaceAll] );
948 Skin := StringReplace( Skin, '&MESSAGE', Res.FBody, [rfReplaceAll] );
949 //----- 縺薙%縺セ縺ァ
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
970 UserOptionalStyle: string;
971 SkinHeader: string;
972 SkinNewRes: string;
973 SkinRes: string;
974 SizeByte: Integer;
975
976 function LoadSkin( fileName: string ): string;
977 begin
978 Result := LoadFromSkin( fileName, ThreadItem, sTitle, SizeByte );
979 end;
980 function ReplaceRes( skin: string ): string;
981 begin
982 Result := SkinedRes( skin, Res, No );
983 end;
984 begin
985 ShortDayNames[1] := '譌・'; ShortDayNames[2] := '譛?#39;;
986 ShortDayNames[3] := '轣ォ'; ShortDayNames[4] := '豌エ';
987 ShortDayNames[5] := '譛ィ'; ShortDayNames[6] := '驥?#39;;
988 ShortDayNames[7] := '蝨?#39;;
989 SizeByte := 0;
990 BBSID := ThreadItem.ParentBoard.BBSID;
991 NewReceiveNo := ThreadItem.NewReceive;
992 ReadList := TStringList.Create;
993 try
994 if ThreadItem.IsLogFile then begin
995 FileName := ThreadItem.GetThreadFileName;
996 ReadList.LoadFromFile(FileName);
997 FAbon.IndividualAbon(ReadList, ChangeFileExt(FileName,'.NG'));
998 FAbon.Execute(ReadList); // 縺ゅ⊂縲懊s縺励※
999 FSelectResFilter.Execute(ReadList); //繝ャ繧ケ縺ョ繝輔ぅ繝ォ繧ソ繝ェ繝ウ繧ー繧偵☆繧?/span>
1000 Res := DivideStrLine(ReadList[0]);
1001 Res.FTitle := StringReplace(Res.FTitle, '????', ',', [rfReplaceAll]);
1002 sTitle := Res.FTitle;
1003 end else begin
1004 sTitle := StringReplace(ThreadItem.Title, '????', ',', [rfReplaceAll]);
1005 end;
1006 SaveList := TStringList.Create;
1007 try
1008 doc.open;
1009 doc.charset := 'Shift_JIS';
1010
1011 // 繝輔か繝ウ繝医d繧オ繧、繧コ縺ョ險ュ螳?/span>
1012 if Length( GikoSys.Setting.BrowserFontName ) > 0 then
1013 UserOptionalStyle := UserOptionalStyle +
1014 'font-family:"' + GikoSys.Setting.BrowserFontName + '";';
1015 if GikoSys.Setting.BrowserFontSize <> 0 then
1016 UserOptionalStyle := UserOptionalStyle +
1017 'font-size:' + IntToStr( GikoSys.Setting.BrowserFontSize ) + 'pt;';
1018 if GikoSys.Setting.BrowserFontColor <> -1 then
1019 UserOptionalStyle := UserOptionalStyle +
1020 'color:#' + IntToHex( GikoSys.Setting.BrowserFontColor, 6 ) + ';';
1021 if GikoSys.Setting.BrowserBackColor <> -1 then
1022 UserOptionalStyle := UserOptionalStyle +
1023 'background-color:#' + IntToHex( GikoSys.Setting.BrowserBackColor, 6 ) + ';';
1024 case GikoSys.Setting.BrowserFontBold of
1025 -1: UserOptionalStyle := UserOptionalStyle + 'font-weight:normal;';
1026 1: UserOptionalStyle := UserOptionalStyle + 'font-weight:bold;';
1027 end;
1028 case GikoSys.Setting.BrowserFontItalic of
1029 -1: UserOptionalStyle := UserOptionalStyle + 'font-style:normal;';
1030 1: UserOptionalStyle := UserOptionalStyle + 'font-style:italic;';
1031 end;
1032
1033 CSSFileName := GetStyleSheetDir + Setting.CSSFileName;
1034 if GikoSys.Setting.UseCSS and
1035 (Pos(GetSkinDir, Setting.CSSFileName) > 0) and
1036 FileExists( GetSkinHeaderFileName ) then begin
1037 // 繧ケ繧ュ繝ウ菴ソ逕ィ
1038 // 繧ケ繧ュ繝ウ縺ョ險ュ螳?/span>
1039 try
1040 SkinHeader := LoadSkin( GetSkinHeaderFileName );
1041 if Length( UserOptionalStyle ) > 0 then
1042 SkinHeader := StringReplace( SkinHeader, '</head>',
1043 '<style type="text/css">body {' + UserOptionalStyle + '}</style></head>', [rfReplaceAll] );
1044 SaveList.Add( SkinHeader );
1045 except
1046 end;
1047 try
1048 SkinNewRes := LoadSkin( GetSkinNewResFileName );
1049 except
1050 end;
1051 try
1052 SkinRes := LoadSkin( GetSkinResFileName );
1053 except
1054 end;
1055
1056 SaveList.Add('<a name="top"></a>');
1057
1058 for i := 0 to ReadList.Count - 1 do begin
1059 if (OnlyAHundredRes = true) and ( i <> 0 ) and ( (ReadList.Count-i) > 101 ) then begin
1060 Continue;
1061 end;
1062 if (Trim(ReadList[i]) <> '') then begin
1063 No := IntToStr(i + 1);
1064
1065 Res := DivideStrLine(ReadList[i]);
1066 Res.FBody := ConvRes(Res.FBody, ThreadItem.ParentBoard.BBSID, ChangeFileExt(ThreadItem.FileName, ''), 'bbs', 'key', 'st', 'to', 'nofirst', 'true');
1067
1068 if Res.FType = glt2chOld then begin
1069 Res.FMailTo := StringReplace(Res.FMailTo, '????', ',', [rfReplaceAll]);
1070 Res.FName := StringReplace(Res.FName, '????', ',', [rfReplaceAll]);
1071 Res.FBody := StringReplace(Res.FBody, '????', ',', [rfReplaceAll]);
1072 end;
1073
1074 Res.FBody := AddAnchorTag(Res.FBody);
1075 if Res.FName = '' then
1076 Res.FName := '&nbsp;';
1077
1078 // 譁ー逹?繝槭?繧ッ
1079 if (NewReceiveNo = (i + 1)) or ((NewReceiveNo = 0) and (i = 0)) then begin
1080 try
1081 SaveList.Add( LoadSkin( GetSkinNewmarkFileName ) );
1082 except
1083 SaveList.Add( '<a name="new"></a>' );
1084 end;
1085 end;
1086 try
1087 if NewReceiveNo <= (i + 1) then
1088 // 譁ー逹?繝ャ繧ケ
1089 SaveList.Add( ReplaceRes( SkinNewRes ) )
1090 else
1091 // 騾壼クク縺ョ繝ャ繧ケ
1092 SaveList.Add( ReplaceRes( SkinRes ) );
1093 except
1094 end;
1095 if ThreadItem.Kokomade = (i + 1) then begin
1096 // 縺薙%縺セ縺ァ隱ュ繧薙□
1097 try
1098 SaveList.Add( LoadSkin( GetSkinBookmarkFileName ) );
1099 except
1100 SaveList.Add( '<a name="koko"></a>' );
1101 end;
1102 end;
1103 end;
1104 SizeByte := SizeByte + Length( SaveList.Text );
1105 doc.Write(SaveList.Text);
1106 SaveList.Clear;
1107 end;
1108 SaveList.Add('<a name="bottom"></a>');
1109 SizeByte := SizeByte + Length( SaveList.Text );
1110 // 繧ケ繧ュ繝ウ(繝輔ャ繧ソ)
1111 try
1112 SaveList.Add( LoadSkin( GetSkinFooterFileName ) );
1113 except
1114 end;
1115 doc.Write(SaveList.Text);
1116
1117 end else if GikoSys.Setting.UseCSS and FileExists(CSSFileName) then begin
1118 //CSS菴ソ逕ィ
1119 //CSSFileName := GetAppDir + CSS_FILE_NAME;
1120 // SaveList.Add('<html lang="ja"><head>');
1121 SaveList.Add('<html><head>');
1122 SaveList.Add('<meta http-equiv="Content-type" content="text/html; charset=Shift_JIS">');
1123 SaveList.Add('<title>' + sTitle + '</title>');
1124 SaveList.Add('<link rel="stylesheet" href="'+CSSFileName+'" type="text/css">');
1125 if Length( UserOptionalStyle ) > 0 then
1126 SaveList.Add('<style type="text/css">body {' + UserOptionalStyle + '}</style>');
1127 SaveList.Add('</head>');
1128 SaveList.Add('<body>');
1129 SaveList.Add('<a name="top"></a>');
1130 SaveList.Add('<div class="title">' + sTitle + '</div>');
1131 doc.Write(SaveList.Text);
1132 SaveList.Clear;
1133 //Application.ProcessMessages;
1134 for i := 0 to ReadList.Count - 1 do begin
1135 if (OnlyAHundredRes = true) and ( i <> 0 ) and ( (ReadList.Count-i) > 101 ) then begin
1136 Continue;
1137 end;
1138 if (Trim(ReadList[i]) <> '') then begin
1139 No := IntToStr(i + 1);
1140 if (NewReceiveNo = (i + 1)) or ((NewReceiveNo = 0) and (i = 0)) then begin
1141 SaveList.Add('<a name="new"></a><div class="new">譁ー逹?繝ャ繧ケ <span class="newdate">' + FormatDateTime('yyyy/mm/dd(ddd) hh:mm', ThreadItem.RoundDate) + '</span></div>');
1142 end;
1143 Res := DivideStrLine(ReadList[i]);
1144 Res.FBody := ConvRes(Res.FBody, ThreadItem.ParentBoard.BBSID, ChangeFileExt(ThreadItem.FileName, ''), 'bbs', 'key', 'st', 'to', 'nofirst', 'true');
1145 Res.FBody := AddAnchorTag(Res.FBody);
1146 if Res.FName = '' then
1147 Res.FName := '&nbsp;';
1148 if Res.FMailTo = '' then
1149 SaveList.Add('<a name="' + No + '"></a>'
1150 + '<div class="header"><span class="no"><a href="menu:' + No + '">' + No + '</a></span> '
1151 + '<span class="name_label">蜷榊燕??lt;/span> '
1152 + '<span class="name"><b>' + Res.FName + '</b></span> '
1153 + '<span class="date_label">謚慕ィソ譌・??lt;/span> '
1154 + '<span class="date">' + Res.FDateTime+ '</span></div>'
1155 + '<div class="mes">' + Res.FBody + ' </div>')
1156 else if GikoSys.Setting.ShowMail then
1157 SaveList.Add('<a name="' + No + '"></a>'
1158 + '<div class="header"><span class="no"><a href="menu:' + No + '">' + No + '</a></span>'
1159 + '<span class="name_label"> 蜷榊燕? </span>'
1160 + '<a class="name_mail" href="mailto:' + Res.FMailTo + '">'
1161 + '<b>' + Res.FName + '</b></a><span class="mail"> [' + Res.FMailTo + ']</span>'
1162 + '<span class="date_label"> 謚慕ィソ譌・??lt;/span>'
1163 + '<span class="date"> ' + Res.FDateTime+ '</span></div>'
1164 + '<div class="mes">' + Res.FBody + ' </div>')
1165 else
1166 SaveList.Add('<a name="' + No + '"></a>'
1167 + '<div class="header"><span class="no"><a href="menu:' + No + '">' + No + '</a></span>'
1168 + '<span class="name_label"> 蜷榊燕? </span>'
1169 + '<a class="name_mail" href="mailto:' + Res.FMailTo + '">'
1170 + '<b>' + Res.FName + '</b></a>'
1171 + '<span class="date_label"> 謚慕ィソ譌・??lt;/span>'
1172 + '<span class="date"> ' + Res.FDateTime+ '</span></div>'
1173 + '<div class="mes">' + Res.FBody + ' </div>');
1174 if ThreadItem.Kokomade = (i + 1) then begin
1175 SaveList.Add('<a name="koko"></a><div class="koko">繧ウ繧ウ縺セ縺ァ隱ュ繧薙□</div>');
1176 end;
1177 end;
1178
1179 doc.Write(SaveList.Text);
1180 SaveList.Clear;
1181 end;
1182 //FOnlyAHundredRes
1183 SaveList.Add('<a name="bottom"></a>');
1184 SaveList.Add('</body></html>');
1185 SaveList.Add('<a name="last"></a>');
1186 SaveList.Add('</body></html>');
1187
1188 doc.Write(SaveList.Text);
1189 end else begin
1190 //CSS髱樔スソ逕ィ
1191 // SaveList.Add('<html lang="ja"><head>');
1192 SaveList.Add('<html><head>');
1193 SaveList.Add('<meta http-equiv="Content-type" content="text/html; charset=Shift_JIS">');
1194 SaveList.Add('<title>' + sTitle + '</title></head>');
1195 SaveList.Add('<body TEXT="#000000" BGCOLOR="#EFEFEF" link="#0000FF" alink="#FF0000" vlink="#660099">');
1196 SaveList.Add('<a name="top"></a>');
1197 SaveList.Add('<font size=+1 color="#FF0000">' + sTitle + '</font>');
1198 SaveList.Add('<dl>');
1199 doc.Write(SaveList.Text);
1200 SaveList.Clear;
1201 //Application.ProcessMessages;
1202 for i := 0 to ReadList.Count - 1 do begin
1203 if (OnlyAHundredRes = true) and ( i <> 0 ) and ( (ReadList.Count-i) > 101 ) then begin
1204 Continue;
1205 end;
1206 if (Trim(ReadList[i]) <> '') then begin
1207 No := IntToStr(i + 1);
1208
1209 if (NewReceiveNo = (i + 1)) or ((NewReceiveNo = 0) and (i = 0)) then begin
1210 SaveList.Add('</dl>');
1211 SaveList.Add('<a name="new"></a>');
1212 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>');
1213 SaveList.Add('<dl>');
1214 end;
1215 Res := DivideStrLine(ReadList[i]);
1216 Res.FBody := ConvRes(Res.FBody, ThreadItem.ParentBoard.BBSID, ChangeFileExt(ThreadItem.FileName, ''), 'bbs', 'key', 'st', 'to', 'nofirst', 'true');
1217 if Res.FType = glt2chOld then begin
1218 Res.FMailTo := StringReplace(Res.FMailTo, '????', ',', [rfReplaceAll]);
1219 Res.FName := StringReplace(Res.FName, '????', ',', [rfReplaceAll]);
1220 Res.FBody := StringReplace(Res.FBody, '????', ',', [rfReplaceAll]);
1221 end;
1222 Res.FBody := AddAnchorTag(Res.FBody);
1223 if Res.FMailTo = '' then
1224 SaveList.Add('<a name="' + No + '"></a><dt><a href="menu:' + No + '">' + No + '</a> 蜷榊燕??lt;font color="forestgreen"><b> ' + Res.FName + ' </b></font> 謚慕ィソ譌・? ' + Res.FDateTime+ '<br><dd>' + Res.Fbody + ' <br><br><br>')
1225 else if GikoSys.Setting.ShowMail then
1226 SaveList.Add('<a name="' + No + '"></a><dt><a href="menu:' + No + '">' + No + '</a> 蜷榊燕??lt;a href="mailto:' + Res.FMailTo + '"><b> ' + Res.FName + ' </B></a> [' + Res.FMailTo + '] 謚慕ィソ譌・? ' + Res.FDateTime+ '<br><dd>' + Res.Fbody + ' <br><br><br>')
1227 else
1228 SaveList.Add('<a name="' + No + '"></a><dt><a href="menu:' + No + '">' + No + '</a> 蜷榊燕??lt;a href="mailto:' + Res.FMailTo + '"><b> ' + Res.FName + ' </B></a> 謚慕ィソ譌・? ' + Res.FDateTime+ '<br><dd>' + Res.Fbody + ' <br><br><br>');
1229 if ThreadItem.Kokomade = (i + 1) then begin
1230 SaveList.Add('</dl>');
1231 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>');
1232 SaveList.Add('<dl>');
1233 end;
1234 end;
1235 //if SaveList.Count > 50 then begin
1236 doc.Write(SaveList.Text);
1237 SaveList.Clear;
1238 //Application.ProcessMessages;
1239 //end;
1240 end;
1241 SaveList.Add('</dl>');
1242 SaveList.Add('<a name="bottom"></a>');
1243 SaveList.Add('</body></html>');
1244 doc.Write(SaveList.Text);
1245 end;
1246 finally
1247 SaveList.Free;
1248 doc.Close;
1249 end;
1250 finally
1251 ReadList.Free;
1252 end;
1253 end;
1254 (*************************************************************************
1255 *http://縺ョ譁?ュ怜?繧誕nchor繧ソ繧ー莉倥″縺ォ縺吶k縲?/span>
1256 *************************************************************************)
1257 function TGikoSys.AddAnchorTag(s: string): string;
1258 const
1259 URL_CHAR: string = '0123456789'
1260 + 'abcdefghijklmnopqrstuvwxyz'
1261 + 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
1262 + '#$%&()*+,-./:;=?@[]^_`{|}~!''\';
1263 var
1264 wkIdx: array[0..9] of Integer;
1265 url: string;
1266 href: string;
1267 i: Integer;
1268 idx: Integer;
1269 begin
1270 Result := '';
1271
1272 while True do begin
1273 wkIdx[0] := AnsiPos('http://', s);
1274 wkIdx[1] := AnsiPos('ttp://', s);
1275 wkIdx[2] := AnsiPos('tp://', s);
1276 wkIdx[3] := AnsiPos('ms-help://', s);
1277 wkIdx[4] := AnsiPos('p://', s);
1278 wkIdx[5] := AnsiPos('https://', s);
1279 wkIdx[6] := AnsiPos('www.', s);
1280 wkIdx[7] := AnsiPos('ftp://', s);
1281 wkIdx[8] := AnsiPos('news://', s);
1282 wkIdx[9] := AnsiPos('rtsp://', s);
1283
1284 idx := MaxInt;
1285 for i := 0 to 8 do
1286 if wkIdx[i] <> 0 then idx := Min(wkIdx[i], idx);
1287
1288 if idx = MaxInt then begin
1289 //繝ェ繝ウ繧ッ縺檎┌縺?h縲?/span>
1290 Result := Result + s;
1291 Break;
1292 end;
1293
1294 if (idx > 1) and (Copy(s, idx - 1, 1) = '"') then begin
1295 //譌「縺ォ繝ェ繝ウ繧ッ繧ソ繧ー縺後▽縺?※縺?k縺」縺ス縺?→縺阪?繝?繧キ
1296 Result := Result + Copy(s, 0, idx + Length('http://') - 1);
1297 s := Copy(s, idx + Length('http://'), length(s));
1298 Continue;
1299 end;
1300
1301 Result := Result + Copy(s, 0, idx - 1);
1302
1303 s := Copy(s, idx, length(s));
1304
1305 for i := 0 to Length(s) do begin
1306 idx := AnsiPos(s[i + 1], URL_CHAR);
1307 if (idx = 0) or (i = (Length(s))) then begin
1308 //URL縺倥c縺ェ縺?枚蟄礼匱隕具シ√→縺九?∵枚蟄励′縺ェ縺上↑縺」縺溘??/span>
1309 url := Copy(s, 0, i);
1310
1311 if AnsiPos('ttp://', url) = 1 then
1312 href := 'h' + url
1313 else if AnsiPos('tp://', url) = 1 then
1314 href := 'ht' + url
1315 else if AnsiPos('p://', url) = 1 then
1316 href := 'htt' + url
1317 else if AnsiPos('www.', url) = 1 then
1318 href := 'http://' + url
1319 else
1320 href := url;
1321 Result := Result + '<a href="' + href + '" target="_blank">' + url + '</a>';
1322 s := Copy(s, i + 1, Length(s));
1323 Break;
1324 end;
1325 end;
1326 end;
1327 end;
1328
1329 (*************************************************************************
1330 *繧オ繝悶ず繧ァ繧ッ繝井ク?陦後r蛻?牡
1331 *************************************************************************)
1332 function TGikoSys.DivideSubject(Line: string): TSubjectRec;
1333 var
1334 i: integer;
1335 ws: WideString;
1336 Delim: string;
1337 LeftK: string;
1338 RightK: string;
1339 begin
1340 Result.FCount := 0;
1341
1342 if Pos('<>', Line) = 0 then
1343 Delim := ','
1344 else
1345 Delim := '<>';
1346
1347 Result.FFileName := GetTokenIndex(Line, Delim, 0);
1348 Result.FTitle := GetTokenIndex(Line, Delim, 1);
1349
1350 ws := Trim(Result.FTitle);
1351
1352 if Copy(ws, Length(ws), 1) = ')' then begin
1353 LeftK := '(';
1354 RightK := ')';
1355 end else if Copy(ws, Length(ws), 1) = '??#39; then begin
1356 LeftK := '??#39;;
1357 RightK := '??#39;;
1358 end else if Copy(ws, Length(ws), 1) = '<' then begin
1359 LeftK := '<';
1360 RightK := '>';
1361 end;
1362
1363 for i := Length(ws) - 1 downto 1 do begin
1364 if ws[i] = LeftK then begin
1365 ws := Copy(ws, i + 1, Length(ws) - i - 1);
1366 if IsNumeric(ws) then
1367 Result.FCount := StrToInt(ws);
1368 Result.FTitle := Trim(StringReplace(Result.FTitle, LeftK + ws + RightK, '', [rfReplaceAll]));
1369 break;
1370 end;
1371 end;
1372 end;
1373
1374 (*************************************************************************
1375 * dat繝輔ぃ繧、繝ォ縺ョ荳?繝ゥ繧、繝ウ繧貞?隗」
1376 *************************************************************************)
1377 function TGikoSys.DivideStrLine(Line: string): TResRec;
1378 var
1379 Delim: string;
1380 bufbody : String;
1381 begin
1382 if Pos('<>', Line) = 0 then begin
1383 Delim := ',';
1384 Result.FType := glt2chOld;
1385 end else begin
1386 Delim := '<>';
1387 Result.FType := glt2chNew;
1388 end;
1389 Result.FName := Trim(GetTokenIndex(Line, Delim, 0));
1390 Result.FMailTo := Trim(GetTokenIndex(Line, Delim, 1));
1391 Result.FDateTime := Trim(GetTokenIndex(Line, Delim, 2));
1392 bufBody := Trim(GetTokenIndex(Line, Delim, 3));
1393 if bufbody = '' then begin
1394 Insert('&nbsp;',bufbody, 1);
1395 end;
1396 Result.FBody := bufBody;
1397 Result.FTitle := Trim(GetTokenIndex(Line, Delim, 4));
1398
1399 end;
1400
1401 (*************************************************************************
1402 * URL縺九iBBSID繧貞叙蠕?/span>
1403 *************************************************************************)
1404 function TGikoSys.UrlToID(url: string): string;
1405 var
1406 i: integer;
1407 begin
1408 Result := '';
1409 url := Trim(url);
1410
1411 if url = '' then Exit;
1412
1413 url := Copy(url, 0, Length(url) - 1);
1414 for i := Length(url) downto 0 do begin
1415 if url[i] = '/' then begin
1416 Result := Copy(url, i + 1, Length(url));
1417 Break;
1418 end;
1419 end;
1420 end;
1421
1422 (*************************************************************************
1423 *URL縺九iBBSID莉・螟悶?驛ィ蛻?http://teri.2ch.net/)繧貞叙蠕?/span>
1424 *************************************************************************)
1425 function TGikoSys.UrlToServer(url: string): string;
1426 var
1427 i: integer;
1428 wsURL: WideString;
1429 begin
1430 Result := '';
1431 wsURL := url;
1432 wsURL := Trim(wsURL);
1433
1434 if wsURL = '' then exit;
1435
1436 if Copy(wsURL, Length(wsURL), 1) = '/' then
1437 wsURL := Copy(wsURL, 0, Length(wsURL) - 1);
1438
1439 for i := Length(wsURL) downto 0 do begin
1440 if wsURL[i] = '/' then begin
1441 Result := Copy(wsURL, 0, i);
1442 break;
1443 end;
1444 end;
1445 end;
1446
1447 (*************************************************************************
1448 *繝?ぅ繝ャ繧ッ繝医Μ縺悟ュ伜惠縺吶k縺九メ繧ァ繝?け
1449 *************************************************************************)
1450 function TGikoSys.DirectoryExistsEx(const Name: string): Boolean;
1451 var
1452 Code: Integer;
1453 begin
1454 Code := GetFileAttributes(PChar(Name));
1455 Result := (Code <> -1) and (FILE_ATTRIBUTE_DIRECTORY and Code <> 0);
1456 end;
1457
1458 (*************************************************************************
1459 *繝?ぅ繝ャ繧ッ繝医Μ菴懈??郁、?焚髫主ア、蟇セ蠢懶シ?/span>
1460 *************************************************************************)
1461 function TGikoSys.ForceDirectoriesEx(Dir: string): Boolean;
1462 begin
1463 Result := True;
1464 if Length(Dir) = 0 then
1465 raise Exception.Create('繝輔か繝ォ繝?縺御ス懈?蜃コ譚・縺セ縺帙s');
1466 Dir := ExcludeTrailingPathDelimiter(Dir);
1467 if (Length(Dir) < 3) or DirectoryExistsEx(Dir)
1468 or (ExtractFilePath(Dir) = Dir) then Exit; // avoid 'xyz:\' problem.
1469 Result := ForceDirectoriesEx(ExtractFilePath(Dir)) and CreateDir(Dir);
1470 end;
1471
1472 (*************************************************************************
1473 *譁?ュ怜?縺九i繝医?繧ッ繝ウ縺ョ蛻?j蜃コ縺暦シ亥?譛溷?逅?シ?/span>
1474 *FDelphi縺九i縺ョ繝代け繝ェ
1475 *************************************************************************)
1476 function TGikoSys.StrTokFirst(const s:string; const sep: TStrTokSeparator; var Rec: TStrTokRec): string;
1477 begin
1478 Rec.Str := s;
1479 Rec.Pos := 1;
1480 Result := StrTokNext(sep, Rec);
1481 end;
1482
1483 (*************************************************************************
1484 *譁?ュ怜?縺九i繝医?繧ッ繝ウ縺ョ蛻?j蜃コ縺?/span>
1485 *FDelphi縺九i縺ョ繝代け繝ェ
1486 *************************************************************************)
1487 function TGikoSys.StrTokNext(const sep: TStrTokSeparator; var Rec: TStrTokRec): string;
1488 var
1489 Len, I: Integer;
1490 begin
1491 with Rec do begin
1492 Len := Length(Str);
1493 Result := '';
1494 if Len >= Pos then begin
1495 while (Pos <= Len) and (Str[Pos] in sep) do begin
1496 Inc(Pos);
1497 end;
1498 I := Pos;
1499 while (Pos<= Len) and not (Str[Pos] in sep) do begin
1500 if IsDBCSLeadByte(Byte(Str[Pos])) then begin
1501 Inc(Pos);
1502 end;
1503 Inc(Pos);
1504 end;
1505 Result := Copy(Str, I, Pos - I);
1506 while (Pos <= Len) and (Str[Pos] in sep) do begin// 縺薙l縺ッ縺雁・ス縺ソ
1507 Inc(Pos);
1508 end;
1509 end;
1510 end;
1511 end;
1512
1513 (*************************************************************************
1514 *繝輔ぃ繧、繝ォ繧オ繧、繧コ蜿門セ?/span>
1515 *************************************************************************)
1516 function TGikoSys.GetFileSize(FileName : string): longint;
1517 var
1518 F : File;
1519 begin
1520 try
1521 if not FileExists(FileName) then begin
1522 Result := 0;
1523 Exit;
1524 end;
1525 Assign(F, FileName);
1526 Reset(F, 1);
1527 Result := FileSize(F);
1528 CloseFile(F);
1529 except
1530 Result := 0;
1531 end;
1532 end;
1533
1534 (*************************************************************************
1535 *繝輔ぃ繧、繝ォ陦梧焚蜿門セ?/span>
1536 *************************************************************************)
1537 function TGikoSys.GetFileLineCount(FileName : string): longint;
1538 var
1539 sl: TStringList;
1540 begin
1541 sl := TStringList.Create;
1542 try
1543 try
1544 sl.LoadFromFile(FileName);
1545 Result := sl.Count;
1546 except
1547 Result := 0;
1548 end;
1549 finally
1550 sl.Free;
1551 end;
1552
1553 end;
1554
1555 (*************************************************************************
1556 *繧ケ繝ャ繝?ラ繝輔ぃ繧、繝ォ縺九i謖?ョ夊。後r蜿門セ?/span>
1557 *************************************************************************)
1558 function TGikoSys.ReadThreadFile(FileName: string; Line: Integer): string;
1559 const
1560 BUFFER_SIZE = 1024;
1561 var
1562 f: TextFile;
1563 s: string;
1564 num: Integer;
1565 ArrBuff: array [1..BUFFER_SIZE] of Char;
1566 begin
1567 Result := '';
1568 if FileExists(FileName) then begin
1569 AssignFile(f, FileName);
1570 System.SetTextBuf(f, ArrBuff);
1571 try
1572 Reset(f);
1573 num := 1;
1574 while not Eof(f) do begin
1575 Readln(f, s);
1576 if Line = num then begin
1577 Result := s;
1578 // CloseFile(f);
1579 Break;
1580 end;
1581 inc(num);
1582 end;
1583 finally
1584 CloseFile(f);
1585 end;
1586 end;
1587 end;
1588
1589 (*************************************************************************
1590 *繧キ繧ケ繝?Β繝。繝九Η繝シ繝輔か繝ウ繝医?螻樊?ァ繧貞叙蠕?/span>
1591 *************************************************************************)
1592 procedure TGikoSys.MenuFont(Font: TFont);
1593 var
1594 lf: LOGFONT;
1595 nm: NONCLIENTMETRICS;
1596 begin
1597 nm.cbSize := sizeof(NONCLIENTMETRICS);
1598
1599 SystemParametersInfo(SPI_GETNONCLIENTMETRICS, 0, @nm, 0);
1600 lf := nm.lfMenuFont;
1601
1602 Font.Name := lf.lfFaceName;
1603 Font.Height := lf.lfHeight;
1604 Font.Style := [];
1605 if lf.lfWeight >= 700 then
1606 Font.Style := Font.Style + [fsBold];
1607 if lf.lfItalic = 1 then
1608 Font.Style := Font.Style + [fsItalic];
1609 end;
1610
1611 (*************************************************************************
1612 *
1613 *縺ゥ縺薙°縺ョ繧オ繧、繝医°繧峨?繝代け繝ェ
1614 *************************************************************************)
1615 function TGikoSys.RemoveToken(var s: string; delimiter: string): string;
1616 var
1617 p: Integer;
1618 begin
1619 p := AnsiPos(delimiter, s);
1620 if p = 0 then
1621 Result := s
1622 else
1623 Result := Copy(s, 1, p - 1);
1624 s := Copy(s, Length(Result) + Length(delimiter) + 1, Length(s));
1625 end;
1626
1627 (*************************************************************************
1628 *
1629 *縺ゥ縺薙°縺ョ繧オ繧、繝医°繧峨?繝代け繝ェ
1630 *************************************************************************)
1631 function TGikoSys.GetTokenIndex(s: string; delimiter: string; index: Integer): string;
1632 var
1633 i: Integer;
1634 begin
1635 Result := '';
1636 for i := 0 to index do
1637 Result := RemoveToken(s, delimiter);
1638 end;
1639
1640 (*************************************************************************
1641 *
1642 *************************************************************************)
1643 function TGikoSys.DeleteLink(const s: string): string;
1644 var
1645 s1: string;
1646 s2: string;
1647 idx: Integer;
1648 i: Integer;
1649 begin
1650 i := 0;
1651 Result := '';
1652 while True do begin
1653 s1 := GetTokenIndex(s, '<a href="', i);
1654 s2 := GetTokenIndex(s, '<a href="', i + 1);
1655
1656 idx := Pos('">', s1);
1657 if idx <> 0 then
1658 Delete(s1, 1, idx + 1);
1659 idx := Pos('">', s2);
1660 if idx <> 0 then
1661 Delete(s2, 1, idx + 1);
1662
1663 Result := Result + s1 + s2;
1664
1665 if s2 = '' then
1666 Break;
1667
1668 inc(i, 2);
1669 end;
1670 end;
1671
1672 //繧、繝ウ繝?ャ繧ッ繧ケ譛ェ譖エ譁ー繝舌ャ繝輔ぃ繧偵ヵ繝ゥ繝?す繝・??/span>
1673 {procedure TGikoSys.FlashExitWrite;
1674 var
1675 i: Integer;
1676 begin
1677 //繧ケ繝ャ繝?ラ繝??繧ソ繝輔ぃ繧、繝ォ繧呈峩譁ー
1678 for i := 0 to FExitWrite.Count - 1 do
1679 WriteThreadDat(FExitWrite[i]);
1680 FExitWrite.Clear;
1681 end;}
1682
1683 (*************************************************************************
1684 *繧ケ繝ャ蜷阪↑縺ゥ繧堤洒縺?錐蜑阪↓螟画鋤縺吶k
1685 *from HotZonu
1686 *************************************************************************)
1687 function TGikoSys.GetShortName(const LongName: string; ALength: integer): string;
1688 const
1689 ERASECHAR : array [1..39] of string =
1690 ('笘?#39;,'笘?#39;,'笆?','笆。','笳?#39;,'笳?#39;,'?ソ','??#39;,'笆イ','笆シ',
1691 '笆ウ','笆ス','笳?#39;,'笳?#39;,'笳?#39;,'縲?#39;,'縲?#39;,'笙ェ','縲?#39;,'縲?#39;,
1692 '窶?#39;,'窶?#39;,'縲?#39;,'縲?#39;,'窶?#39;,'窶?#39;,'??#39;,'??#39;,'竕ェ','竕ォ',
1693 '??#39;,'??#39;,'縲?#39;,'縲?#39;,'縲?#39;,'縲?#39;,'縲?#39;,'窶ヲ', '縲?');
1694 var
1695 Chr : array [0..255] of char;
1696 S : string;
1697 i : integer;
1698 begin
1699 s := Trim(LongName);
1700 if (Length(s) <= ALength) then begin
1701 Result := s;
1702 end else begin
1703 S := s;
1704 for i := Low(ERASECHAR) to High(ERASECHAR) do begin
1705 S := StringReplace(S, ERASECHAR[i], '', [rfReplaceAll]);
1706 end;
1707 if (Length(S) <= ALength) then begin
1708 Result := S;
1709 end else begin
1710 Windows.LCMapString(
1711 GetUserDefaultLCID(),
1712 LCMAP_HALFWIDTH,
1713 PChar(S),
1714 Length(S) + 1,
1715 chr,
1716 Sizeof(chr)
1717 );
1718 S := Chr;
1719 S := Copy(S,1,ALength);
1720 while true do begin
1721 if (ByteType(S, Length(S)) = mbLeadByte ) then begin
1722 S := Copy(S, 1, Length(S) - 1);
1723 end else begin
1724 Break;
1725 end;
1726 end;
1727 Result := S;
1728 end;
1729 end;
1730 end;
1731
1732 (*************************************************************************
1733 *
1734 * from HotZonu
1735 *************************************************************************)
1736 function TGikoSys.ConvRes(const Body, Bbs, Key,
1737 ParamBBS, ParamKey, ParamStart, ParamTo, ParamNoFirst, ParamTrue : string): string;
1738 type
1739 PIndex = ^TIndex;
1740 TIndex = record
1741 FIndexFrom : integer;
1742 FIndexTo : integer;
1743 FNo : string;
1744 end;
1745 const
1746 GT = '&gt;';
1747 SN = '0123456789-';
1748 ZN = '?撰シ托シ抵シ難シ費シ包シ厄シ暦シ假シ吮?';
1749 var
1750 i : integer;
1751 s,r : string;
1752 b : TMbcsByteType;
1753 sw: boolean;
1754 sp: integer;
1755 No: string;
1756 sx: string;
1757 List: TList;
1758 oc : string;
1759 st, et: string;
1760 chk : boolean;
1761 al : boolean;
1762 procedure Add(IndexFrom, IndexTo: integer; const No: string);
1763 var
1764 FIndex : PIndex;
1765 begin
1766 New(FIndex);
1767 FIndex.FIndexFrom := IndexFrom;
1768 FIndex.FIndexTo := IndexTo;
1769 FIndex.FNo := No;
1770 List.Add(FIndex);
1771 end;
1772 function ChooseString(const Text, Separator: string; Index: integer): string;
1773 var
1774 S : string;
1775 i, p : integer;
1776 begin
1777 S := Text;
1778 for i := 0 to Index - 1 do begin
1779 if (AnsiPos(Separator, S) = 0) then S := ''
1780 else S := Copy(S, AnsiPos(Separator, S) + Length(Separator), Length(S));
1781 end;
1782 p := AnsiPos(Separator, S);
1783 if (p > 0) then Result := Copy(S, 1, p - 1) else Result := S;
1784 end;
1785 begin
1786 { v1.0 b2 - 03 }
1787 s := Body;
1788 r := Body;
1789 i := 1;
1790 sw := False;
1791 No := '';
1792 List:= TList.Create;
1793 oc := '';
1794 sp := 0;
1795 chk := False;
1796 al := False;
1797 while true do begin
1798 b := ByteType(s, i);
1799 case b of
1800 mbSingleByte : begin
1801 if (not sw) and (Copy(s,i,8) = GT + GT) then begin
1802 if (AnsiPos('<A HREF', AnsiUpperCase(oc)) = 0) then begin
1803 sw := True;
1804 sp := i;
1805 i := i + 7;
1806 oc:='';
1807 chk := True;
1808 end;
1809 end else
1810 if (not sw) and (Copy(s,i,8) = GT + GT) then begin
1811 if (AnsiPos('<A HREF', AnsiUpperCase(oc)) = 1) then begin
1812 i := i + 7;
1813 oc:='';
1814 chk := True;
1815 end;
1816 end else
1817 if (not sw) and (Copy(s,i,4) = GT) then begin
1818 if (AnsiPos('<A HREF', AnsiUpperCase(oc)) = 0) then begin
1819 sw := True;
1820 sp := i;
1821 i := i + 3;
1822 oc:='';
1823 chk := True;
1824 end;
1825 end else
1826 if ((not sw) and (Copy(s,i,1) = ',')) or
1827 ((not sw) and (Copy(s,i,1) = '=')) then begin
1828 if ((not Chk) and (AnsiLowerCase(oc) = '</a>')) or
1829 ((Chk) and (oc = '')) or
1830 ((not Chk) and (al)) then
1831 begin
1832 sw := True;
1833 sp := i;
1834 //i := i + 1;
1835 oc:='';
1836 end;
1837 end else
1838 if (sw) then begin
1839 sx := Copy(s,i,1);
1840 if (AnsiPos(sx, SN) > 0) then begin
1841 No := No + sx;
1842 end else begin
1843 if (No <> '') and (No <> '-') then begin
1844 Add(sp, i, No);
1845 al := True;
1846 end;
1847 sw := False;
1848 //
1849 i := i - 1;
1850 //
1851 No := '';
1852 oc:='';
1853 //chk := False;
1854 end;
1855 end else begin
1856 if Copy(s,i,1) = '<' then oc := '';
1857 oc := oc + Copy(s,i,1);
1858 chk := False;
1859 al := False;
1860 end;
1861 end;
1862 mbLeadByte : begin
1863 if (not sw) and (Copy(s,i,4) = '?橸シ?#39;) then begin
1864 sw := True;
1865 sp := i;
1866 i := i + 3;
1867 chk := True;
1868 end else
1869 if (not sw) and (Copy(s,i,2) = '??#39;) then begin
1870 sw := True;
1871 sp := i;
1872 i := i + 1;
1873 chk := True;
1874 end else
1875 if (sw) then begin
1876 sx := Copy(s,i,2);
1877 if (AnsiPos(sx, ZN) > 0) then begin
1878 No := No + ZenToHan(sx);
1879 end else begin
1880 if (No <> '') and (No <> '-') and (No <> '竏?#39;) then begin
1881 Add(sp, i, No);
1882 end;
1883 sw := False;
1884 i := i - 1;
1885 No := '';
1886 end;
1887 end else begin
1888 oc := '';
1889 chk := False;
1890 end;
1891 al := False;
1892 end;
1893 end;
1894 inc(i);
1895 if (i > Length(Body)) then begin
1896 if (sw) then begin
1897 if (No <> '') then Add(sp, i, No);
1898 end;
1899 Break;
1900 end;
1901 end;
1902 for i := List.Count - 1 downto 0 do begin
1903 if (AnsiPos('-', PIndex(List[i]).FNo) > 0) then begin
1904 st := ChooseString(PIndex(List[i]).FNo, '-', 0);
1905 et := ChooseString(PIndex(List[i]).FNo, '-', 1);
1906 end else begin
1907 st := PIndex(List[i]).FNo;
1908 et := PIndex(List[i]).FNo;
1909 end;
1910 r := Copy(r,0, PIndex(List[i]).FIndexFrom - 1) +
1911 Format('<a href="../test/read.cgi?%s=%s&%s=%s&%s=%s&%s=%s&%s=%s" target="_blank">',
1912 [ParamBBS, Bbs, ParamKey, Key, ParamStart, st, ParamTo, et, ParamNoFirst, ParamTrue]) +
1913 Copy(r,PIndex(List[i]).FIndexFrom, PIndex(List[i]).FIndexTo - PIndex(List[i]).FIndexFrom) + '</A>' +
1914 Copy(r,PIndex(List[i]).FIndexTo,Length(r));
1915 Dispose(PIndex(List[i]));
1916 end;
1917 List.Free;
1918 Result := r;
1919 end;
1920
1921 (*************************************************************************
1922 * 蜈ィ隗停?蜊願ァ?/span>
1923 * from HotZonu
1924 *************************************************************************)
1925 function TGikoSys.ZenToHan(const s: string): string;
1926 var
1927 Chr: array [0..255] of char;
1928 begin
1929 Windows.LCMapString(
1930 GetUserDefaultLCID(),
1931 // LCMAP_HALFWIDTH,
1932 LCMAP_HALFWIDTH or LCMAP_KATAKANA or LCMAP_LOWERCASE,
1933 PChar(s),
1934 Length(s) + 1,
1935 chr,
1936 Sizeof(chr)
1937 );
1938 Result := Chr;
1939 end;
1940
1941 (*************************************************************************
1942 * 蜈ィ隗貞濠隗偵?繧峨′縺ェ縺九◆縺九↑繧貞玄蛻・縺励↑縺??縺Пos
1943 *************************************************************************)
1944 function TGikoSys.VaguePos(const Substr, S: string): Integer;
1945 begin
1946 Result := Pos(ZenToHan(Substr), ZenToHan(S));
1947 end;
1948
1949 function TGikoSys.BoolToInt(b: Boolean): Integer;
1950 begin
1951 Result := IfThen(b, 1, 0);
1952 end;
1953
1954 function TGikoSys.IntToBool(i: Integer): Boolean;
1955 begin
1956 Result := i = 1;
1957 end;
1958
1959 //gzip縺ァ蝨ァ邵ョ縺輔l縺溘?繧呈綾縺?/span>
1960 function TGikoSys.GzipDecompress(ResStream: TStream; ContentEncoding: string): string;
1961 const
1962 BUF_SIZE = 4096;
1963 var
1964 GZipStream: TGzipDecompressStream;
1965 TextStream: TStringStream;
1966 buf: array[0..BUF_SIZE - 1] of Byte;
1967 cnt: Integer;
1968 s: string;
1969 i: Integer;
1970 begin
1971 Result := '';
1972 TextStream := TStringStream.Create('');
1973 try
1974 //繝弱?繝医Φ繧ヲ繝ウ繝√え繧」繝ォ繧ケ2003蟇セ遲?x-gzip縺ィ縺九↓縺ェ繧九∩縺溘>)
1975 // if LowerCase(Trim(ContentEncoding)) = 'gzip' then begin
1976 if AnsiPos('gzip', LowerCase(Trim(ContentEncoding))) > 0 then begin
1977 ResStream.Position := 0;
1978 GZipStream := TGzipDecompressStream.Create(TextStream);
1979 try
1980 repeat
1981 FillChar(buf, BUF_SIZE, 0);
1982 cnt := ResStream.Read(buf, BUF_SIZE);
1983 if cnt > 0 then
1984 GZipStream.Write(buf, BUF_SIZE);
1985 until cnt = 0;
1986 finally
1987 GZipStream.Free;
1988 end;
1989 end else begin
1990 ResStream.Position := 0;
1991 repeat
1992 FillChar(buf, BUF_SIZE, 0);
1993 cnt := ResStream.Read(buf, BUF_SIZE);
1994 if cnt > 0 then
1995 TextStream.Write(buf, BUF_SIZE);
1996 until cnt = 0;
1997 end;
1998
1999 //NULL譁?ュ励r"*"縺ォ縺吶k
2000 s := TextStream.DataString;
2001 i := Length(s);
2002 while (i > 0) and (s[i] = #0) do
2003 Dec(i);
2004 s := Copy(s, 1, i);
2005
2006 i := Pos(#0, s);
2007 while i <> 0 do begin
2008 s[i] := '*';
2009 i := Pos(#0, s);
2010 end;
2011 Result := s;
2012 finally
2013 TextStream.Free;
2014 end;
2015 end;
2016
2017 procedure TGikoSys.LoadKeySetting(ActionList: TActionList);
2018 const
2019 STD_SEC = 'KeySetting';
2020 var
2021 i: Integer;
2022 ini: TMemIniFile;
2023 ActionName: string;
2024 ActionKey: Integer;
2025 SecList: TStringList;
2026 Component: TComponent;
2027 begin
2028 if not FileExists(GetConfigDir + KEY_SETTING_FILE_NAME) then
2029 Exit;
2030 SecList := TStringList.Create;
2031 ini := TMemIniFile.Create(GetConfigDir + KEY_SETTING_FILE_NAME);
2032 try
2033 ini.ReadSection(STD_SEC, SecList);
2034 for i := 0 to SecList.Count - 1 do begin
2035 ActionName := SecList[i];
2036 ActionKey := ini.ReadInteger(STD_SEC, ActionName, -1);
2037 if ActionKey <> -1 then begin
2038 Component := ActionList.Owner.FindComponent(ActionName);
2039 if TObject(Component) is TAction then begin
2040 TAction(Component).ShortCut := ActionKey;
2041 end;
2042 end;
2043 end;
2044 finally
2045 ini.Free;
2046 SecList.Free;
2047 end;
2048 end;
2049
2050 procedure TGikoSys.SaveKeySetting(ActionList: TActionList);
2051 const
2052 STD_SEC = 'KeySetting';
2053 var
2054 i: Integer;
2055 ini: TMemIniFile;
2056 begin
2057 ini := TMemIniFile.Create(GetConfigDir + KEY_SETTING_FILE_NAME);
2058 try
2059 for i := 0 to ActionList.ActionCount - 1 do begin
2060 if ActionList.Actions[i].Tag = -1 then
2061 Continue;
2062 ini.WriteInteger(STD_SEC, ActionList.Actions[i].Name, TAction(ActionList.Actions[i]).ShortCut);
2063 end;
2064 ini.UpdateFile;
2065 finally
2066 ini.Free;
2067 end;
2068 end;
2069
2070 //
2071 procedure TGikoSys.CreateProcess(const AppPath: string; const Param: string);
2072 var
2073 PI: TProcessInformation;
2074 SI: TStartupInfo;
2075 Path: string;
2076 begin
2077 Path := '"' + AppPath + '"';
2078 if Param <> '' then
2079 Path := Path + ' ' + Param;
2080
2081 SI.Cb := SizeOf(Si);
2082 SI.lpReserved := nil;
2083 SI.lpDesktop := nil;
2084 SI.lpTitle := nil;
2085 SI.dwFlags := 0;
2086 SI.cbReserved2 := 0;
2087 SI.lpReserved2 := nil;
2088 SI.dwysize := 0;
2089 Windows.CreateProcess(nil,
2090 PChar(Path),
2091 nil,
2092 nil,
2093 False,
2094 0,
2095 nil,
2096 nil,
2097 SI,
2098 PI);
2099 end;
2100
2101 procedure TGikoSys.OpenBrowser(URL: string; BrowserType: TGikoBrowserType);
2102 begin
2103 case BrowserType of
2104 gbtIE:
2105 HlinkNavigateString(nil, PWideChar(WideString(URL)));
2106 gbtUserApp, gbtAuto:
2107 if (Setting.URLApp) and (FileExists(Setting.URLAppFile)) then
2108 GikoSys.CreateProcess(Setting.URLAppFile, URL)
2109 else
2110 HlinkNavigateString(nil, PWideChar(WideString(URL)));
2111 end;
2112 end;
2113
2114 function TGikoSys.HTMLDecode(const AStr: String): String;
2115 var
2116 Sp, Rp, Cp, Tp: PChar;
2117 S: String;
2118 I, Code: Integer;
2119 Num: Boolean;
2120 begin
2121 SetLength(Result, Length(AStr));
2122 Sp := PChar(AStr);
2123 Rp := PChar(Result);
2124 //Cp := Sp;
2125 try
2126 while Sp^ <> #0 do begin
2127 case Sp^ of
2128 '&': begin
2129 //Cp := Sp;
2130 Inc(Sp);
2131 case Sp^ of
2132 'a': if AnsiStrPos(Sp, 'amp;') = Sp then
2133 begin
2134 Inc(Sp, 3);
2135 Rp^ := '&';
2136 end;
2137 'l',
2138 'g': if (AnsiStrPos(Sp, 'lt;') = Sp) or (AnsiStrPos(Sp, 'gt;') = Sp) then
2139 begin
2140 Cp := Sp;
2141 Inc(Sp, 2);
2142 while (Sp^ <> ';') and (Sp^ <> #0) do
2143 Inc(Sp);
2144 if Cp^ = 'l' then
2145 Rp^ := '<'
2146 else
2147 Rp^ := '>';
2148 end;
2149 'q': if AnsiStrPos(Sp, 'quot;') = Sp then
2150 begin
2151 Inc(Sp,4);
2152 Rp^ := '"';
2153 end;
2154 '#': begin
2155 Tp := Sp;
2156 Inc(Tp);
2157 Num := IsNumeric(Copy(Tp, 1, 1));
2158 while (Sp^ <> ';') and (Sp^ <> #0) do begin
2159 if (Num) and (not IsNumeric(Copy(Sp, 1, 1))) then
2160 Break;
2161 Inc(Sp);
2162 end;
2163 SetString(S, Tp, Sp - Tp);
2164 Val(S, I, Code);
2165 Rp^ := Chr((I));
2166 end;
2167 // else
2168 //raise EConvertError.CreateFmt(sInvalidHTMLEncodedChar,
2169 //[Cp^ + Sp^, Cp - PChar(AStr)])
2170 end;
2171 end
2172 else
2173 Rp^ := Sp^;
2174 end;
2175 Inc(Rp);
2176 Inc(Sp);
2177 end;
2178 except
2179 // on E:EConvertError do
2180 // raise EConvertError.CreateFmt(sInvalidHTMLEncodedChar,
2181 // [Cp^ + Sp^, Cp - PChar(AStr)])
2182 end;
2183 SetLength(Result, Rp - PChar(Result));
2184 end;
2185
2186 function TGikoSys.GetHRefText(s: string): string;
2187 var
2188 Index: Integer;
2189 Index2: Integer;
2190 begin
2191 Result := '';
2192 s := Trim(s);
2193 if s = '' then
2194 Exit;
2195
2196 Index := AnsiPos('href', LowerCase(s));
2197 if Index = 0 then
2198 Exit;
2199 s := Trim(Copy(s, Index + 4, Length(s)));
2200 s := Trim(Copy(s, 2, Length(s)));
2201
2202 //蟋九a縺ョ譁?ュ励′'"'縺ェ繧牙叙繧企勁縺?/span>
2203 if Copy(s, 1, 1) = '"' then begin
2204 s := Trim(Copy(s, 2, Length(s)));
2205 end;
2206
2207 Index := AnsiPos('"', s);
2208 if Index <> 0 then begin
2209 //'"'縺セ縺ァURL縺ィ縺吶k
2210 s := Copy(s, 1, Index - 1);
2211 end else begin
2212 //'"'縺檎┌縺代l縺ー繧ケ繝壹?繧ケ縺?quot;>"縺ョ譌ゥ縺?婿縺セ縺ァ繧旦RL縺ィ縺吶k
2213 Index := AnsiPos(' ', s);
2214 Index2 := AnsiPos('>', s);
2215 if Index = 0 then
2216 Index := Index2;
2217 if Index > Index2 then
2218 Index := Index2;
2219 if Index <> 0 then
2220 s := Copy(s, 1, Index - 1)
2221 else
2222 //縺薙l莉・荳翫b縺?衍繧峨s縺ャ
2223 ;
2224 end;
2225 Result := Trim(s);
2226 end;
2227
2228 //繝帙せ繝亥錐縺鯉シ抵ス?ス医°縺ゥ縺?°繝√ぉ繝?け縺吶k
2229 function TGikoSys.Is2chHost(Host: string): Boolean;
2230 const
2231 HOST_NAME: array[0..1] of string = ('2ch.net', 'bbspink.com');
2232 var
2233 i: Integer;
2234 // Len: Integer;
2235 begin
2236 Result := False;
2237 OutputDebugString(pchar(HOST_NAME[0]));
2238 for i := 0 to Length(HOST_NAME) - 1 do begin
2239 // Len := Length(HOST_NAME[i]);
2240 if AnsiPos(HOST_NAME[i], Host) = (Length(Host) - Length(HOST_NAME[i]) + 1) then begin
2241 Result := True;
2242 Exit;
2243 end;
2244 end;
2245 end;
2246
2247 function TGikoSys.Parse2chURL(const url: string; const path: string; const document: string; var BBSID: string; var BBSKey: string): Boolean;
2248 const
2249 READ_PATH: string = '/test/read.cgi/';
2250 OLD_READ_PATH: string = '/test/read.cgi?';
2251 KAKO_PATH: string = '/kako/';
2252 var
2253 Index: Integer;
2254 s: string;
2255 SList: TStringList;
2256 begin
2257 BBSID := '';
2258 BBSKey := '';
2259 Result := False;
2260
2261 Index := AnsiPos(READ_PATH, path);
2262 if Index <> 0 then begin
2263 s := Copy(path, Length(READ_PATH) + 1, Length(path));
2264 BBSID := GetTokenIndex(s, '/', 0);
2265 BBSKey := GetTokenIndex(s, '/', 1);
2266 if BBSKey = '' then
2267 BBSKey := Document;
2268 Result := (BBSID <> '') or (BBSKey <> '');
2269 Exit;
2270 end;
2271 Index := AnsiPos(KAKO_PATH, path);
2272 if Index <> 0 then begin
2273 s := Copy(path, 2, Length(path));
2274 BBSID := GetTokenIndex(s, '/', 0);
2275 if (BBSID = 'log') and (GetTokenIndex(s, '/', 2) = 'kako') then
2276 BBSID := GetTokenIndex(s, '/', 1);
2277 BBSKey := ChangeFileExt(Document, '');
2278 Result := (BBSID <> '') or (BBSKey <> '');
2279 Exit;
2280 end;
2281 Index := AnsiPos('read.cgi?', URL);
2282 if Index <> 0 then begin
2283 SList := TStringList.Create;
2284 try
2285 try
2286 // s := HTMLDecode(Document);
2287 ExtractHTTPFields(['?', '&'], [], PChar(URL), SList, False);
2288 BBSID := SList.Values['bbs'];
2289 BBSKey := SList.Values['key'];
2290 Result := (BBSID <> '') or (BBSKey <> '');
2291 Exit;
2292 except
2293 Exit;
2294 end;
2295 finally
2296 SList.Free;
2297 end;
2298 end;
2299 end;
2300
2301 function TGikoSys.Parse2chURL2(URL: string): TPathRec;
2302 var
2303 i: Integer;
2304 s: string;
2305 wk: string;
2306 wkMin: Integer;
2307 wkMax: Integer;
2308 wkInt: Integer;
2309 RStart: Integer;
2310 RLength: Integer;
2311 SList: TStringList;
2312 begin
2313 URL := Trim(LowerCase(URL));
2314 Result.FBBS := '';
2315 Result.FKey := '';
2316 Result.FSt := 0;
2317 Result.FTo := 0;
2318 Result.FFirst := False;
2319 Result.FStBegin := False;
2320 Result.FToEnd := False;
2321 Result.FDone := False;
2322
2323 wkMin := 0;
2324 wkMax := 1;
2325
2326 FAWKStr.RegExp := 'http://.+\.(2ch\.net|bbspink\.com)/';
2327 if FAWKStr.Match(FAWKStr.ProcessEscSeq(URL), RStart, RLength) = 0 then
2328 Exit;
2329 s := Copy(URL, RStart + RLength - 1, Length(URL));
2330
2331 //讓呎コ匁嶌蠑?/span>
2332 //譛?蠕後?l50, 10, 10-20, 10n, 10-20n, -10, 10-, 10n- 縺ェ縺ゥ
2333 //http://xxx.2ch.net/test/read.cgi/bbsid/1000000000/
2334 FAWKStr.RegExp := '/test/read.cgi/.+/[0-9]+/.*';
2335 if FAWKStr.Match(FAWKStr.ProcessEscSeq(s), RStart, RLength) > 0 then begin
2336 s := Copy(s, 15, Length(s));
2337
2338 SList := TStringList.Create;
2339 try
2340 SList.Clear;
2341 FAWKStr.RegExp := '/';
2342 if FAWKStr.Split(FAWKStr.ProcessEscSeq(s), SList) >= 2 then begin
2343 Result.FBBS := SList[1];
2344 Result.FKey := SList[2];
2345 if SList.Count >= 3 then
2346 s := SList[3]
2347 else
2348 s := '';
2349 end else
2350 Exit;
2351
2352 SList.Clear;
2353 FAWKStr.LineSeparator := mcls_CRLF;
2354 FAWKStr.RegExp := '-';
2355 if FAWKStr.Split(FAWKStr.ProcessEscSeq(s), SList) = 0 then begin
2356 Result.FFirst := True;
2357 end else begin
2358 FAWKStr.RegExp := 'l[0-9]+';
2359 if FAWKStr.Match(FAWKStr.ProcessEscSeq(s), RStart, RLength) > 0 then begin
2360 Result.FFirst := True;
2361 end else begin
2362 for i := 0 to SList.Count - 1 do begin
2363 if Trim(SList[i]) = '' then begin
2364 if i = 0 then
2365 Result.FStBegin := True;
2366 if i = (SList.Count - 1) then
2367 Result.FToEnd := True;
2368 end else if IsNumeric(SList[i]) then begin
2369 wkInt := StrToInt(SList[i]);
2370 wkMax := Max(wkMax, wkInt);
2371 if wkMin = 0 then
2372 wkMin := wkInt
2373 else
2374 wkMin := Min(wkMin, wkInt);
2375 end else if Trim(SList[i]) = 'n' then begin
2376 Result.FFirst := True;
2377 end else begin
2378 FAWKStr.RegExp := '^n[0-9]+$|^[0-9]+n$';
2379 if FAWKStr.Match(FAWKStr.ProcessEscSeq(SList[i]), RStart, RLength) > 0 then begin
2380 if Copy(SList[i], 1, 1) = 'n' then
2381 wkInt := StrToInt(Copy(SList[i], 2, Length(SList[i])))
2382 else
2383 wkInt := StrToInt(Copy(SList[i], 1, Length(SList[i]) - 1));
2384 Result.FFirst := True;
2385 wkMax := Max(wkMax, wkInt);
2386 if wkMin = 1 then
2387 wkMin := wkInt
2388 else
2389 wkMin := Min(wkMin, wkInt);
2390 end;
2391 end;
2392 end;
2393 if Result.FStBegin and (not Result.FToEnd) then
2394 Result.FSt := wkMin
2395 else if (not Result.FStBegin) and Result.FToEnd then
2396 Result.FTo := wkMax
2397 else if (not Result.FStBegin) and (not Result.FToEnd) then begin
2398 Result.FSt := wkMin;
2399 Result.FTo := wkMax;
2400 end;
2401 //Result.FSt := wkMin;
2402 //Result.FTo := wkMax;
2403 end;
2404 end;
2405 finally
2406 SList.Free;
2407 end;
2408 Result.FDone := True;
2409 Exit;
2410 end;
2411
2412 //譁ーkako譖ク蠑?/span>
2413 //http://server.2ch.net/ITA_NAME/kako/1000/10000/1000000000.html
2414 FAWKStr.RegExp := '/.+/kako/[0-9]+/[0-9]+/[0-9]+\.html';
2415 if FAWKStr.Match(FAWKStr.ProcessEscSeq(s), RStart, RLength) > 0 then begin
2416 SList := TStringList.Create;
2417 try
2418 SList.Clear;
2419 FAWKStr.RegExp := '/';
2420 if FAWKStr.Split(FAWKStr.ProcessEscSeq(s), SList) >= 6 then begin
2421 Result.FBBS := SList[1];
2422 Result.FKey := ChangeFileExt(SList[5], '');
2423 Result.FFirst := True;
2424 end else
2425 Exit;
2426 finally
2427 SList.Free;
2428 end;
2429 Result.FDone := True;
2430 Exit;
2431 end;
2432
2433 //譌ァkako譖ク蠑?/span>
2434 //http://server.2ch.net/ITA_NAME/kako/999/999999999.html
2435 FAWKStr.RegExp := '/.+/kako/[0-9]+/[0-9]+\.html';
2436 if FAWKStr.Match(FAWKStr.ProcessEscSeq(s), RStart, RLength) > 0 then begin
2437 SList := TStringList.Create;
2438 try
2439 SList.Clear;
2440 FAWKStr.RegExp := '/';
2441 if FAWKStr.Split(FAWKStr.ProcessEscSeq(s), SList) >= 5 then begin
2442 Result.FBBS := SList[1];
2443 Result.FKey := ChangeFileExt(SList[4], '');
2444 Result.FFirst := True;
2445 end else
2446 Exit;
2447 finally
2448 SList.Free;
2449 end;
2450 Result.FDone := True;
2451 Exit;
2452 end;
2453
2454 //log蜿翫?log2譖ク蠑?/span>
2455 //http://server.2ch.net/log/ITA_NAME/kako/999/999999999.html
2456 //http://server.2ch.net/log2/ITA_NAME/kako/999/999999999.html
2457 FAWKStr.RegExp := '/log2?/.+/kako/[0-9]+/[0-9]+\.html';
2458 if FAWKStr.Match(FAWKStr.ProcessEscSeq(s), RStart, RLength) > 0 then begin
2459 SList := TStringList.Create;
2460 try
2461 SList.Clear;
2462 FAWKStr.RegExp := '/';
2463 if FAWKStr.Split(FAWKStr.ProcessEscSeq(s), SList) >= 6 then begin
2464 Result.FBBS := SList[2];
2465 Result.FKey := ChangeFileExt(SList[5], '');
2466 Result.FFirst := True;
2467 end else
2468 Exit;
2469 finally
2470 SList.Free;
2471 end;
2472 Result.FDone := True;
2473 Exit;
2474 end;
2475
2476
2477 //譌ァURL譖ク蠑?/span>
2478 //http://server.2ch.net/test/read.cgi?bbs=ITA_NAME&key=1000000000&st=1&to=5&nofirst=true
2479 FAWKStr.RegExp := '/test/read\.cgi\?';
2480 if FAWKStr.Match(FAWKStr.ProcessEscSeq(s), RStart, RLength) > 0 then begin
2481 s := Copy(s, 16, Length(s));
2482 SList := TStringList.Create;
2483 try
2484 SList.Clear;
2485 FAWKStr.RegExp := '&';
2486 if FAWKStr.Split(FAWKStr.ProcessEscSeq(s), SList) >= 2 then begin
2487 Result.FFirst := True;
2488 for i := 0 to SList.Count - 1 do begin
2489 if Pos('bbs=', SList[i]) = 1 then begin
2490 Result.FBBS := Copy(SList[i], 5, Length(SList[i]));
2491 end else if Pos('key=', SList[i]) = 1 then begin
2492 Result.FKey := Copy(SList[i], 5, Length(SList[i]));
2493 end else if Pos('st=', SList[i]) = 1 then begin
2494 wk := Copy(SList[i], 4, Length(SList[i]));
2495 if IsNumeric(wk) then
2496 Result.FSt := StrToInt(wk)
2497 else if wk = '' then
2498 Result.FStBegin := True;
2499 end else if Pos('to=', SList[i]) = 1 then begin
2500 wk := Copy(SList[i], 4, Length(SList[i]));
2501 if IsNumeric(wk) then
2502 Result.FTo := StrToInt(wk)
2503 else if wk = '' then
2504 Result.FToEnd := True;
2505 end else if Pos('nofirst=', SList[i]) = 1 then begin
2506 Result.FFirst := False;
2507 end;
2508 end;
2509 end else
2510 Exit;
2511 finally
2512 SList.Free;
2513 end;
2514
2515 if (Result.FBBS <> '') and (Result.FKey <> '') then begin
2516 Result.FDone := True;
2517 end;
2518 Exit;
2519 end;
2520 end;
2521
2522 procedure TGikoSys.ParseURI(var URL, Protocol, Host, Path, Document, Port, Bookmark: string);
2523 var
2524 URI: TIdURI;
2525 begin
2526 Protocol := '';
2527 Host := '';
2528 Path := '';
2529 Document := '';
2530 Port := '';
2531 Bookmark := '';
2532 URI := TIdURI.Create(URL);
2533 try
2534 Protocol := URI.Protocol;
2535 Host := URI.Host;
2536 Path := URI.Path;
2537 Document := URI.Document;
2538 Port := URI.Port;
2539 Bookmark := URI.Bookmark;
2540 finally
2541 URI.Free;
2542 end;
2543 end;
2544
2545 function TGikoSys.GetVersionBuild: Integer;
2546 var
2547 FixedFileInfo: PVSFixedFileInfo;
2548 VersionHandle, VersionSize: DWORD;
2549 pVersionInfo: Pointer;
2550 ItemLen : UInt;
2551 AppFile: string;
2552 begin
2553 Result := 0;
2554 AppFile := Application.ExeName;
2555 VersionSize := GetFileVersionInfoSize(pChar(AppFile), VersionHandle);
2556 if VersionSize = 0 then
2557 Exit;
2558 GetMem(pVersionInfo, VersionSize);
2559 try
2560 if GetFileVersionInfo(PChar(AppFile),VersionHandle,VersionSize, pVersionInfo) then
2561 if VerQueryValue(pVersionInfo, '\', Pointer(FixedFileInfo), ItemLen) then
2562 Result := LOWORD(FixedFileInfo^.dwFileVersionLS);
2563 finally
2564 FreeMem(pVersionInfo, VersionSize);
2565 end;
2566 end;
2567
2568 initialization
2569 GikoSys := TGikoSys.Create;
2570
2571 finalization
2572 if GikoSys <> nil then begin
2573 GikoSys.Free;
2574 GikoSys := nil;
2575 end;
2576 end.

Back to OSDN">Back to OSDN
ViewVC Help
Powered by ViewVC 1.1.26