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.1.1.1 - (show annotations) (download) (as text) (vendor branch)
Sat Aug 9 13:51:05 2003 UTC (20 years, 8 months ago) by hi_
Branch: hi
CVS Tags: b33
Changes since 1.1: +0 -0 lines
File MIME type: text/x-pascal
ソキオャコ?ョ

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

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