Develop and Download Open Source Software

Browse CVS Repository

Contents of /gikonavigoeson/gikonavi/AbonUnit.pas

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.23 - (show annotations) (download) (as text)
Tue Apr 20 14:53:57 2004 UTC (20 years ago) by h677
Branch: MAIN
Changes since 1.22: +76 -270 lines
File MIME type: text/x-pascal
レスポップアップのあぼ〜ん有効にしてても、透明あぼ〜んをスルーする不具合の修正。
使わない関数の削除。

1 unit AbonUnit;
2
3 interface
4 uses
5 Windows,Messages, ShellAPI, SysUtils, Classes,StdCtrls,StrUtils;
6
7 type
8 TIndiviAbon = record
9 Res: Integer;
10 option: Integer; // 0:?? 1:??絽吾???若?若??
11 end;
12
13 TAbon = class(TObject)
14 private
15 { Private 絎h? }
16 Froot : String;
17 Flistpath : String;
18 FNGwordpath : String;
19 Ftokens : array of array of string;
20 FAbonRes : array of TIndiviAbon;
21 FAbonString : String;
22 FCutoffNum : Integer; //?????遺札筝??g??????????怨???NG???若????????
23 FDeleterlo : Boolean; //&rlo;???????? //菴遵??&lro;??????
24 FReplaceul :Boolean ; //<ul>?帥?違??<br>?帥?違??舟????????
25 FReverse : Boolean ; //NG???若???с?????若?????????????荵≪????????
26 FAbonPopupRes : Boolean; //???鴻???????≪?????????????若?若????????
27 FCreateNGwordFile : Boolean; //??絎???????path??G???若??txt???<???c??????????????????????????
28 FNGwordFileIndex : Integer; //?上????粋昭???с??NG???若????list???茵?????
29 FNGwordname : String; //?上????粋昭???с??NG???若????;腓阪??
30 FIndividualFileName : String; //???ャ???若?????????<?ゃ????
31 FReturnNGwordLineNum : Boolean; //NG???若??????違??菴?????
32 FSetNGResAnchor : Boolean; //NG???綵????????????????????????鴻?吾?????鴻?≪?潟???若???ゃ????????????
33 FDeleteSyria: Boolean; //?激???∵??????????膈?鐚?&#1792~&#1871鐚?
34 procedure SetTokens(index: integer ; argline:String);
35 function Getlistpath() : String;
36 procedure Setlistpath(const Value : String);
37 function LoadListFile(path :String;listStringList : TStringList) : Boolean;
38 function ReadNGwordslist(line : Integer) : Boolean;
39 function LoadFromSetResNumFile(SetResNumFile : String) : Boolean;
40 public
41 { Public 絎h? }
42 constructor Create; // ?潟?潟?鴻????????/span>
43 destructor Destroy; override; // ???鴻????????/span>
44 property Deleterlo: Boolean read FDeleterlo write FDeleterlo default false;
45 property Replaceul: Boolean read FReplaceul write FReplaceul default false;
46 property Reverse: Boolean read FReverse write FReverse default false;
47 property CreateNGwordFile: Boolean read FCreateNGwordFile write FCreateNGwordFile;
48 property AbonString : String read FAbonString write FAbonString;
49 property AbonPopupRes : Boolean read FAbonPopupRes write FAbonPopupRes default false;
50 property listpath : String read Getlistpath write Setlistpath;
51 property NGwordFileIndex : Integer read FNGwordFileIndex write FNGwordFileIndex default 0;
52 property NGwordname : String read FNGwordname write FNGwordname;
53 property ReturnNGwordLineNum : Boolean read FReturnNGwordLineNum write FReturnNGwordLineNum default false;
54 property SetNGResAnchor : Boolean read FSetNGResAnchor write FSetNGResAnchor default false;
55 property DeleteSyria : Boolean read FDeleteSyria write FDeleteSyria default false;
56 procedure Setroot(root :String);
57 function Getroot() : String;
58
59 function Getfullpath(argpath : String) : String;
60 procedure SetNGwordpath(path :String);
61 function GetNGwordpath() : String;
62 function LoadFromNGwordFile(path :String) : Boolean;
63 function ReLoadFromNGwordFile() : Boolean;
64 procedure LoadFromStringList( bufstl : TStringList );
65 function CheckAbonPopupRes(line : String) :Boolean;
66 function FindNGwords(const line : String; var NGwordsLineNum : Integer; var Invisible : Boolean) : Boolean;//1???ゃ?潟???ょ????
67 function Cutoff(line : String) : Boolean; //CutOff?や札筝??????????掩?違??筝????с??????true
68 //???若????????(NG???若???с?????c???帥???潟??
69 procedure Execute(var ThreadStrings : TStringList); overload;
70 procedure Execute(var ThreadStrings : TStringList; NGwords : TStringList); overload;
71 procedure Execute(var ThreadStrings : TStringList; NGwords : TStrings); overload;
72 procedure Execute(var ResString : String; ResNumber : Integer); overload; //筝祉??lugin??????at To HTML ??/span>
73 //???ャ???若??????????
74 procedure IndividualAbon(var ThreadStrings : TStringList; SetResNumFile : String); overload;
75 procedure IndividualAbon(var ResString : String; SetResNumFile : String; ResNumber : Integer); overload;
76 procedure AddIndividualAbon( ResNum : Integer ; option : Integer);
77 procedure DeleteIndividualAbon( ResNum : Integer);
78 function GetAbonResCount() : Integer;
79 function GetAbonResString(Num : Integer) : String;
80 function CheckIndividualAbonList(ResNum : Integer) : Boolean;
81
82 procedure EditNGwords(); //NGword.txt???????
83 function ShowAllTokens() : String; //???????亥??/span>
84 //--
85 procedure GoHome();//List???茵?????茯???
86 function GoForward() : Boolean; //List????ゆ???G???若?????<?ゃ????茯??粋昭??
87 function GoBack() : Boolean; //List????ゅ????G???若?????<?ゃ????茯??粋昭??
88 //--
89 function TreatSyria(AString: string): string;
90 end;
91 var
92 Abon1 :TAbon;
93 const
94 NGwordListFileName : String = 'NGwords.list';
95
96 implementation
97
98 uses MojuUtils;
99
100 constructor TAbon.Create;
101 begin
102 // ??????
103 FAbonString := '&nbsp;<>&nbsp;<>&nbsp;<>&nbsp;&nbsp;<><>';
104 FCreateNGwordFile := true;
105 SetLength(FAbonRes,1);
106 FAbonRes[0].Res := 0;
107 FAbonRes[0].option := -1;
108
109 end;
110
111 destructor TAbon.Destroy;
112 begin
113 inherited;
114 end;
115 //root??xe\config\NGwords????????
116 procedure TAbon.Setroot(root :String);
117 var
118 bufStringList : TStringList;
119 begin
120 bufStringList := TStringList.Create;
121 try
122 if not DirectoryExists(root) then begin
123 CreateDir(root);
124 end;
125 if root[Length(root)] <> '\' then begin
126 root := root + '\';
127 end;
128 Flistpath := root + NGwordListFileName;
129 LoadListFile(Flistpath, bufStringList);
130 finally
131 bufStringList.Free;
132 end;
133 Froot := root;
134 end;
135 function TAbon.Getroot() : String;
136 begin
137 Result := Froot;
138 end;
139 //NGwordpath??Gword.txt??????????/span>
140 procedure TAbon.SetNGwordpath(path :String);
141 begin
142 FNGwordpath := Getfullpath(path);
143 LoadFromNGwordFile(FNGwordpath);
144 end;
145 function TAbon.GetNGwordpath() : String;
146 begin
147 Result := FNGwordpath;
148 end;
149 //???????鴻?с???????違???????鴻???????????
150 function TAbon.Getfullpath(argpath : String) : String;
151 begin
152 if AnsiPos(':\',argpath) <> 2 then begin //?????ゃ???????????????鴻???<??????/span>
153 if Getroot() = '' then begin
154 Result := ''; //root???鴻??荐??????????????腥冴??????
155 end else begin
156 if (Froot[Length(Froot)] = '\') and (argpath[1] = '\') then begin //????????????/span>
157 Delete(argpath,1,1);
158 end;
159 Insert( Getroot(), argpath , 1);//root???鴻???水??/span>
160 Result := argpath;
161 end;
162 end else begin
163 Result := argpath;
164 end;
165
166 end;
167 //NGword???<?ゃ??????粋昭??/span>
168 function TAbon.LoadFromNGwordFile(path :String) : boolean;
169 var
170 bufstl : TStringList;
171 begin
172 path := Getfullpath(path);
173 if path = '' then begin
174 Result := false;
175 end else begin
176 bufstl := TStringList.Create;
177 try
178 try
179 bufstl.LoadFromFile(path);
180 LoadFromStringList( bufstl );
181 Result := true;
182 except
183 if CreateNGwordFile = true then begin
184 bufstl.SaveToFile(path);
185 end;
186 Result := false;
187 end;
188 finally
189 bufstl.Free;
190 end;
191 end;
192
193 end;
194 //NGword???鴻??茯??粋昭??/span>
195 procedure TAbon.LoadFromStringList( bufstl : TStringList );
196 var
197 i : integer;
198 begin
199 try
200 for i := bufstl.Count -1 downto 0 do begin
201 if bufstl.Strings[i] = '' then begin
202 bufstl.Delete(i);
203 end;
204 end;
205 SetLength(Ftokens,bufstl.Count);
206 for i := 0 to bufstl.Count -1 do begin
207 SetTokens(i , bufstl.Strings[i]);
208 end;
209
210 except
211 Exit;
212 end;
213 end;
214 //NGwordpath???≪??┃絎??????????????????????若?????∽??/span>
215 function TAbon.ReLoadFromNGwordFile() : boolean;
216 begin
217 if GetNGwordpath() ='' then begin
218 Result := false;
219 end else begin
220 Result := LoadFromNGwordFile( GetNGwordpath() );
221 end;
222 end;
223 function TAbon.Getlistpath() : String;
224 begin
225 Result := Flistpath;
226 end;
227 procedure TAbon.Setlistpath(const Value : String);
228 begin
229 Flistpath := Getfullpath(Value);
230 end;
231 //筝?茵???賢?????若???潟?????????????祉????
232 procedure TAbon.SetTokens(index: integer ; argline : String);
233 var
234 ret : Integer;
235 bufstl : TStringList;
236 i : Integer;
237 pos : Integer;
238 buftoken : String;
239 begin
240 pos := 0;
241 bufstl := TStringList.Create;
242 try
243 if Length(argline) > 0 then begin
244 pos := AnsiPos(#9,argline);
245 while pos <> 0 DO begin
246 buftoken := Copy(argline,1,pos-1);
247 Delete(argline,1,pos);
248 if Length(buftoken) > 0 then begin
249 bufstl.Append(buftoken);
250 end else if ( bufstl.Count = 0 ) then begin
251 bufstl.Append('');
252 end;
253 pos := AnsiPos(#9,argline);
254 end;
255 if Length(argline) > 0 then begin
256 bufstl.Append(argline);
257 end;
258 ret := bufstl.Count;
259 SetLength(Ftokens[index],ret);
260 for i := 0 to bufstl.Count - 1 do begin
261 Ftokens[index][i] := bufstl.Strings[i];
262 end;
263 end;
264 finally
265 bufstl.Free;
266 end;
267
268 end;
269 //Debug???<??????G???若?????障??????????
270 function TAbon.ShowAllTokens() : String;
271 var
272 i : Integer;
273 j : Integer;
274 ret : String;
275 begin
276 for i := 0 to High(Ftokens) do begin
277 for j := 0 to High(Ftokens[i]) do begin
278 ret := ret + Ftokens[i][j];
279 end;
280 end;
281 Result := ret;
282
283
284
285 end;
286
287 //****************************************************************************//
288 //NG???若???????障????????true??菴?????
289 {function TAbon.FindNGwords(const line : String) : Boolean;
290 var
291 lines : Integer;
292 cells : Integer;
293 hit : Boolean;
294
295 bufline : String;
296 begin
297 hit := false;
298 if AnsiPos(FAbonString,line) <> 1 then begin
299 for lines := 0 to High(Ftokens) do begin
300 hit := true;
301 bufline := line;
302 for cells := 0 to High(Ftokens[lines]) do begin
303 if AnsiPos(Ftokens[lines][cells],bufline) = 0 then begin
304 hit := false;
305 break;
306 end else begin
307 Delete(bufline,AnsiPos(Ftokens[lines][cells],bufline),Length(Ftokens[lines][cells]));
308 end;
309 end;
310 if hit = true then begin
311 break;
312 end;
313 end;
314 end;
315 Result := hit;
316 end;
317 //NG???若???????障??????????true??菴?????????G???若??????違??NGwordsLineNum???ャ???????
318 function TAbon.FindNGwords(const line : String; var NGwordsLineNum : Integer) : Boolean;
319 var
320 lines : Integer;
321 cells : Integer;
322 hit : Boolean;
323 bufline : String;
324 begin
325 hit := false;
326 if AnsiPos(FAbonString,line) <> 1 then begin
327 for lines := 0 to High(Ftokens) do begin
328 hit := true;
329 bufline := line;
330 for cells := 0 to High(Ftokens[lines]) do begin
331 if AnsiPos(Ftokens[lines][cells],bufline) = 0 then begin
332 hit := false;
333 break;
334 end else begin
335 Delete(bufline,AnsiPos(Ftokens[lines][cells],bufline),Length(Ftokens[lines][cells]));
336 end;
337 end;
338 if hit = true then begin
339 NGwordsLineNum := lines + 1;
340 break;
341 end;
342 end;
343 end;
344 Result := hit;
345 end;
346 }
347 //NG???若???????障??????????true??菴?????????G???若??????違??NGwordsLineNum???ャ?????????
348 //????????????若??????????????Inbisible??true?????????
349 function TAbon.FindNGwords(const line : String; var NGwordsLineNum : Integer; var Invisible : Boolean) : Boolean; //1???ゃ?潟???ょ????
350 var
351 lines : Integer;
352 cells : Integer;
353 hit : Boolean;
354 bufline : String;
355 start : Integer;
356 begin
357 hit := false;
358 if AnsiPos(FAbonString,line) <> 1 then begin
359 for lines := 0 to High(Ftokens) do begin
360 hit := true;
361 bufline := line;
362 if Ftokens[lines][0] <> '' then begin
363 Invisible := false;
364 start := 0;
365 end else begin
366 Invisible := true;
367 start := 1;
368 end;
369
370 for cells := start to High(Ftokens[lines]) do begin
371 if AnsiPos(Ftokens[lines][cells],bufline) = 0 then begin
372 hit := false;
373 break;
374 end else begin
375 Delete(bufline,AnsiPos(Ftokens[lines][cells],bufline),Length(Ftokens[lines][cells]));
376 end;
377 end;
378 if hit = true then begin
379 NGwordsLineNum := lines + 1;
380 break;
381 end;
382 end;
383 end;
384 Result := hit;
385 end;
386
387 //CutOff?や札筝??????????掩?違??筝????с??????true
388 function TAbon.Cutoff(line : String) : Boolean;
389 var
390 i : Integer;
391 sheed : AnsiChar;
392 buf : String;
393 ret : Bool;
394 begin
395 ret := false;
396 if FCutoffNum <> 0 then begin
397 for i := 65 to 90 do begin
398 sheed := Chr(i);
399 buf := DupeString(sheed, FCutoffNum);
400 if AnsiContainsText(line, buf) = true then begin
401 ret := true;
402 break;
403 end;
404 end;
405 end;
406 Result := ret;
407 end;
408 //??鮎?????若???ゃ??rue??????NG???若??????????????????菴?????
409 procedure TAbon.Execute(var ThreadStrings : TStringList);
410 var
411 i : Integer;
412 NGwordsLine : Integer;
413 bufline : String;
414 invisi : Boolean;
415 begin
416 for i:=0 to ThreadStrings.Count - 1 do begin
417 NGwordsLine := 0;
418 if FindNGwords(ThreadStrings.Strings[i], NGwordsLine ,invisi) <> Reverse then begin
419 if invisi = true then begin
420 ThreadStrings.Strings[i] := '';
421 end else begin
422 if not ReturnNGwordLineNum and not SetNGResAnchor then begin
423 ThreadStrings.Strings[i] := FAbonString;
424 end else if not ReturnNGwordLineNum then begin
425 ThreadStrings.Strings[i] := Format('&nbsp;<>&nbsp;<>&nbsp;<>&gt;%d<><>',[(i+1)]);
426 end else if not SetNGResAnchor then begin
427 ThreadStrings.Strings[i] := Format('&nbsp;<>&nbsp;<>&nbsp;<><B> %d 茵?????G???若???????障???????障????</B><><>',[NGwordsLine]);
428 end else begin
429 ThreadStrings.Strings[i] := Format('&nbsp;<>&nbsp;<>&nbsp;<><B> %d 茵?????G???若???????障???????障????</B>&gt;%d <><>',[NGwordsLine,(i+1)]);
430 end;
431 end;
432 end else begin
433 bufline := ThreadStrings.Strings[i];
434 if Deleterlo = true then begin
435 bufline := CustomStringReplace(bufline,'&rlo;','');
436 bufline := CustomStringReplace(bufline,'&lro;','');
437 end;
438 if Replaceul = true then begin
439 bufline := CustomStringReplace( bufline,'<ul>','<br>' );
440 bufline := CustomStringReplace( bufline,'</ul>','<br>' );
441 end;
442 if DeleteSyria = true then
443 bufline := TreatSyria(bufline);
444 ThreadStrings.Strings[i] := bufline;
445 end;
446 end;
447 end;
448 procedure TAbon.Execute(var ResString : String; ResNumber : Integer);
449 var
450 NGwordsLine : Integer;
451 bufline : String;
452 invisi : Boolean;
453 begin
454 NGwordsLine := 0;
455 if FindNGwords(ResString, NGwordsLine ,invisi) <> Reverse then begin
456 if invisi = true then begin
457 ResString := '';
458 end else begin
459 if not ReturnNGwordLineNum and not SetNGResAnchor then begin
460 ResString := FAbonString;
461 end else if not ReturnNGwordLineNum then begin
462 ResString := Format('&nbsp;<>&nbsp;<>&nbsp;<>&gt;%d<><>',[(ResNumber)]);
463 end else if not SetNGResAnchor then begin
464 ResString := Format('&nbsp;<>&nbsp;<>&nbsp;<><B> %d 茵?????G???若???????障???????障????</B><><>',[NGwordsLine]);
465 end else begin
466 ResString := Format('&nbsp;<>&nbsp;<>&nbsp;<><B> %d 茵?????G???若???????障???????障????</B>&gt;%d <><>',[NGwordsLine,(ResNumber)]);
467 end;
468 end;
469 end else begin
470 bufline := ResString;
471 if Deleterlo = true then begin
472 bufline := CustomStringReplace( bufline,'&rlo;','' );
473 bufline := CustomStringReplace( bufline,'&lro;','' );
474 end;
475 if Replaceul = true then begin
476 bufline := CustomStringReplace( bufline,'<ul>','<br>' );
477 bufline := CustomStringReplace( bufline,'</ul>','<br>' );
478 end;
479 if DeleteSyria = true then
480 bufline := TreatSyria(bufline);
481 ResString := bufline;
482 end;
483 end;
484
485 procedure TAbon.Execute(var ThreadStrings : TStringList; NGwords : TStringList);
486 var
487 i : Integer;
488 begin
489 SetLength(Ftokens,NGwords.Count);
490 for i := 0 to NGwords.Count -1 do begin
491 SetTokens(i , NGwords.Strings[i]);
492 end;
493 Execute(ThreadStrings);
494
495 end;
496 procedure TAbon.Execute(var ThreadStrings : TStringList; NGwords : TStrings);
497 var
498 i : Integer;
499 buf : TStringList;
500 begin
501 buf := TStringList.Create;
502 buf.AddStrings(NGwords);
503 SetLength(Ftokens,buf.Count);
504 for i := 0 to buf.Count -1 do begin
505 SetTokens(i , buf.Strings[i]);
506 end;
507 Execute(ThreadStrings);
508 buf.Free;
509 end;
510
511
512 //****************************************************************************//
513 //?上???祉??????????????NGword.txt??????span>
514 procedure TAbon.EditNGwords();
515 begin
516 ShellExecute(0 ,nil,PChar(FNGwordpath),nil,nil,SW_SHOW);
517 end;
518 //???????≪???????ゅ??∽??/span>
519 function TAbon.CheckAbonPopupRes(line : String) :Boolean;
520 var
521 i: Integer;
522 v: boolean;
523 begin
524 if AbonPopupRes = true then begin
525 Result := FindNGwords(line, i ,v);
526 end else begin
527 Result := false;
528 end;
529 end;
530 //茲??違??G???若???????鴻????茯??粋昭??==============================================
531 //List???<?ゃ????茯??粋昭??
532 function TAbon.LoadListFile(path :String; listStringList : TStringList) : Boolean;
533 begin
534 try
535 listStringList.LoadFromFile(path);
536 Result := true;
537 except
538 listStringList.Append('筝???NGword.txt');
539 listStringList.SaveToFile(path);
540 Result := false;
541 end;
542 end;
543 //List????ゆ???G???若?????<?ゃ????茯??粋昭??
544 function TAbon.GoForward() : Boolean;
545 begin
546 FNGwordFileIndex := FNGwordFileIndex + 1;
547 Result := ReadNGwordslist(FNGwordFileIndex);
548 end;
549 //List????ゅ????G???若?????<?ゃ????茯??粋昭??
550 function TAbon.GoBack() : Boolean;
551 begin
552 FNGwordFileIndex := FNGwordFileIndex -1;
553 Result := ReadNGwordslist(FNGwordFileIndex);
554 end;
555 //List???茵?????茯???
556 procedure TAbon.GoHome();
557 begin
558 FNGwordFileIndex := 0;
559 ReadNGwordslist(FNGwordFileIndex);
560 end;
561 //List??ine茵?????茯???
562 function TAbon.ReadNGwordslist(line : Integer) : Boolean;
563 var
564 liststl : TStringList;
565 linebuf : String;
566 begin
567 liststl := TStringList.Create;
568 try
569 if LoadListFile(Flistpath,liststl) = true then begin
570 if line < 0 then begin
571 line := liststl.Count - 1;
572 FNGwordFileIndex := liststl.Count - 1;
573 end else if line > liststl.Count - 1 then begin
574 line := 0;
575 FNGwordFileIndex := 0;
576 end;
577 linebuf := liststl.Strings[line];
578 FNGwordname := Copy(linebuf,1,AnsiPos('=',linebuf)-1);
579 Delete(linebuf,1,AnsiPos('=',linebuf));
580 SetNGwordpath(linebuf);
581 Result := true;
582 end else begin
583 Result := false;
584 end
585 finally
586 liststl.Free;
587 end;
588
589 end;
590 //茲??違??G???若???????鴻????茯??粋昭??=====?????障??================================
591 //???ャ???若????絎?茵??∽??/span>
592 procedure TAbon.IndividualAbon(var ThreadStrings : TStringList; SetResNumFile : String);
593 var
594 i : Integer;
595 begin
596 if FileExists(SetResNumFile) = true then begin
597 if LoadFromSetResNumFile(SetResNumFile) = true then begin
598 for i := 0 to High(FAbonRes) do begin
599 if (FAbonRes[i].Res <= ThreadStrings.Count) and (FAbonRes[i].Res > 0) then begin
600 if FAbonRes[i].option = 0 then begin
601 ThreadStrings.Strings[FAbonRes[i].Res-1] := '';
602 end else begin
603 ThreadStrings.Strings[FAbonRes[i].Res-1] := '???若????<>???若????<>???若????<>???若????<>';
604 end;
605 end;
606
607 end;
608 end;
609 end else begin
610 FIndividualFileName := SetResNumFile;
611 SetLength(FAbonRes,1);
612 FAbonRes[0].Res := 0;
613 FAbonRes[0].option := -1;
614 end;
615 end;
616 procedure TAbon.IndividualAbon(var ResString : String; SetResNumFile : String; ResNumber : Integer);
617 var
618 i : Integer;
619 begin
620 if FileExists(SetResNumFile) = true then begin
621 if LoadFromSetResNumFile(SetResNumFile) = true then begin
622 for i := 0 to High(FAbonRes) do begin
623 if FAbonRes[i].Res = ResNumber then begin
624 if FAbonRes[i].option = 0 then begin
625 ResString := '';
626 end else begin
627 ResString := '???若????<>???若????<>???若????<>???若????<>';
628 end;
629 Exit;
630 end;
631 end;
632 end;
633 end else begin
634 FIndividualFileName := SetResNumFile;
635 SetLength(FAbonRes,1);
636 FAbonRes[0].Res := 0;
637 FAbonRes[0].option := -1;
638 end;
639 end;
640
641 //???ャ???若???????<?ゃ????粋昭?翠?∽??/span>
642 function TAbon.LoadFromSetResNumFile(SetResNumFile : String) : Boolean;
643 var
644 bufStringList : TStringList;
645 bufLine : String;
646 i : Integer;
647 begin
648 bufStringList := TStringList.Create;
649 try
650 try
651 bufStringList.LoadFromFile(SetResNumFile);
652 FIndividualFileName := SetResNumFile;
653 //腥肴?????/span>
654 for i := bufStringList.Count-1 downto 0 do begin
655 if bufStringList.Strings[i] = '' then begin
656 bufStringList.Delete(i);
657 end;
658 end;
659
660 //?<?≪??∈篆?
661 SetLength(FAbonRes,bufStringList.Count);
662 //篁e??/span>
663 for i :=0 to bufStringList.Count - 1 do begin
664 bufLine := Trim(bufStringList.Strings[i]);
665 FAbonRes[i].Res := StrToInt(Copy(bufLine,1,AnsiPos('-',bufLine)-1));
666 FAbonRes[i].option := StrToInt(Copy(bufLine,AnsiPos('-',bufLine)+1,1));
667 end;
668 except
669 Result := false;
670 Exit;
671 end;
672 finally
673 bufStringList.Free;
674 end;
675 Result := true;
676 end;
677 //???ャ???若???????<?ゃ????申??
678 procedure TAbon.AddIndividualAbon( ResNum : Integer ; option : Integer);
679 var
680 IndividualFile : TStringList;
681 linebuf : String;
682 i : Integer;
683 begin
684 IndividualFile := TStringList.Create;
685 if FAbonRes[0].Res <> 0 then begin
686 for i := 0 to High(FAbonRes) do begin
687 if FAbonRes[i].Res <> ResNum then begin
688 linebuf := IntToStr(FAbonRes[i].Res) + '-' + IntToStr(FabonRes[i].option);
689 IndividualFile.Append(linebuf);
690 end;
691 end;
692 end;
693 linebuf := IntToStr(ResNum) + '-' + IntToStr(option);
694 IndividualFile.Append(linebuf);
695 try
696 IndividualFile.SaveToFile(FIndividualFileName);
697 finally
698 IndividualFile.Free;
699 end;
700 end;
701 //???ャ???若???????<?ゃ??????????/span>
702 procedure TAbon.DeleteIndividualAbon( ResNum : Integer);
703 var
704 IndividualFile : TStringList;
705 linebuf : String;
706 i : Integer;
707 begin
708 IndividualFile := TStringList.Create;
709 if FAbonRes[0].Res <> 0 then begin
710 for i := 0 to High(FAbonRes) do begin
711 if FAbonRes[i].Res <> ResNum then begin
712 linebuf := IntToStr(FAbonRes[i].Res) + '-' + IntToStr(FabonRes[i].option);
713 IndividualFile.Append(linebuf);
714 end;
715 end;
716 end;
717 if IndividualFile.Count <> 0 then begin
718 try
719 IndividualFile.SaveToFile(FIndividualFileName);
720 finally
721 IndividualFile.Free;
722 end;
723 end else begin
724 if FileExists(FIndividualFileName) = true then begin
725 DeleteFile(FIndividualFileName);
726 end;
727 end;
728 end;
729 //???ャ???若?????????鴻???????違??菴???
730 function TAbon.GetAbonResCount() : Integer;
731 var
732 i : Integer;
733 begin
734 if FAbonRes[0].Res = 0 then begin
735 Result := 0
736 end else begin
737 i := High(FAbonRes);
738 Result := i+1;
739 end;
740 end;
741 //???ャ???若?????????鴻?????茵????????鴻????絖????ц???
742 function TAbon.GetAbonResString(Num : Integer) : String;
743 begin
744 if (Num <= High(FAbonRes)) and (Num >= 0) then begin
745 Result := IntToStr(FAbonRes[Num].Res);
746 end else begin
747 Result := '';
748 end;
749 end;
750 //???????≪???????ゅ???/span>
751 function TAbon.CheckIndividualAbonList(ResNum : Integer) : Boolean;
752 var
753 i : Integer;
754 begin
755 if FAbonRes[0].Res <> 0 then begin
756 for i := 0 to High(FAbonRes) do begin
757 if FAbonRes[i].Res = ResNum then begin
758 Result := true;
759 Exit;
760 end;
761 end;
762 end;
763 Result := false;
764
765 end;
766 //?激???∵??????????膈?
767 function TAbon.TreatSyria(AString: string): string;
768 var
769 //count: Integer; //(&#1792~&#1871)
770 pos: Integer;
771 tmp: string;
772 begin
773 pos := AnsiPos('&#18', AString);
774 while pos <> 0 do begin
775 if AString[pos+6] = ';' then begin
776 if StrToIntDef(Copy(AString, pos+4, 2), 0) <= 71 then begin
777 tmp := tmp + Copy(AString, 1, pos - 1);
778 Delete(AString, 1, pos+6);
779 end else begin
780 tmp := tmp + Copy(AString, 1, pos + 6);
781 Delete(AString, 1, pos+6);
782 end;
783 end else begin
784 tmp := tmp + Copy(AString, 1, pos + 3);
785 Delete(AString, 1, pos+3);
786 end;
787 pos := AnsiPos('&#18', AString);
788 end;
789 if Length(AString) > 0 then
790 tmp := tmp + AString;
791 AString := tmp;
792 tmp := '';
793
794 pos := AnsiPos('&#179', AString);
795 while pos <> 0 do begin
796 if AString[pos+6] = ';' then begin
797 if StrToIntDef(Copy(AString, pos+5, 1), 0) > 2 then begin
798 tmp := tmp + Copy(AString, 1, pos - 1);
799 Delete(AString, 1, pos+6);
800 end else begin
801 tmp := tmp + Copy(AString, 1, pos + 6);
802 Delete(AString, 1, pos+6);
803 end;
804 tmp := tmp + Copy(AString, 1, pos - 1);
805 Delete(AString, 1, pos+6);
806 end else begin
807 tmp := tmp + Copy(AString, 1, pos + 4);
808 Delete(AString, 1, pos+4);
809 end;
810 pos := AnsiPos('&#179', AString);
811 end;
812 if Length(AString) > 0 then
813 tmp := tmp + AString;
814 Result := tmp;
815 end;
816 end.
817

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