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.28 - (show annotations) (download) (as text)
Fri Oct 8 15:12:52 2004 UTC (19 years, 6 months ago) by h677
Branch: MAIN
Changes since 1.27: +102 -50 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 FindNGwordsEx(const line : String; var NGwordsLineNum : Integer; var Invisible : Boolean) : Boolean;//1???ゃ?潟???ょ????
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 procedure ExecuteEx(var ThreadStrings : TStringList); overload;
74 procedure ExecuteEx(var ThreadStrings : TStringList; NGwords : TStringList); overload;
75 procedure ExecuteEx(var ThreadStrings : TStringList; NGwords : TStrings); overload;
76 procedure ExecuteEx(var ResString : String; ResNumber : Integer); overload; //筝祉??lugin??????at To HTML ??/span>
77
78 //???ャ???若??????????
79 procedure IndividualAbon(var ThreadStrings : TStringList; SetResNumFile : String); overload;
80 procedure IndividualAbon(var ResString : String; SetResNumFile : String; ResNumber : Integer); overload;
81 procedure AddIndividualAbon( ResNum : Integer ; option : Integer; SetResNumFile : String);
82 procedure DeleteIndividualAbon( ResNum : Integer); overload;
83 procedure DeleteIndividualAbon( ResNum : Integer; SetResNumFile : String); overload;
84
85 function GetAbonResCount() : Integer; overload;
86 function GetAbonResCount(SetResNumFile : String) : Integer; overload;
87
88 function GetAbonResString(Num : Integer) : String;
89 function CheckIndividualAbonList(ResNum : Integer) : Boolean;
90
91 procedure EditNGwords(); //NGword.txt???????
92 function ShowAllTokens() : String; //???????亥??/span>
93 //--
94 procedure GoHome();//List???茵?????茯???
95 function GoForward() : Boolean; //List????ゆ???G???若?????<?ゃ????茯??粋昭??
96 function GoBack() : Boolean; //List????ゅ????G???若?????<?ゃ????茯??粋昭??
97 //--
98 function TreatSyria(AString: string): string;
99 end;
100 var
101 Abon1 :TAbon;
102 const
103 NGwordListFileName : String = 'NGwords.list';
104
105 implementation
106
107 uses MojuUtils;
108
109 constructor TAbon.Create;
110 begin
111 // ??????
112 FAbonString := '&nbsp;<>&nbsp;<>&nbsp;<>&nbsp;&nbsp;<><>';
113 FCreateNGwordFile := true;
114 SetLength(FAbonRes,1);
115 FAbonRes[0].Res := 0;
116 FAbonRes[0].option := -1;
117
118 end;
119
120 destructor TAbon.Destroy;
121 begin
122 inherited;
123 end;
124 //root??xe\config\NGwords????????
125 procedure TAbon.Setroot(root :String);
126 var
127 bufStringList : TStringList;
128 begin
129 bufStringList := TStringList.Create;
130 try
131 if not DirectoryExists(root) then begin
132 CreateDir(root);
133 end;
134 if root[Length(root)] <> '\' then begin
135 root := root + '\';
136 end;
137 Flistpath := root + NGwordListFileName;
138 LoadListFile(Flistpath, bufStringList);
139 finally
140 bufStringList.Free;
141 end;
142 Froot := root;
143 end;
144 function TAbon.Getroot() : String;
145 begin
146 Result := Froot;
147 end;
148 //NGwordpath??Gword.txt??????????/span>
149 procedure TAbon.SetNGwordpath(path :String);
150 begin
151 FNGwordpath := Getfullpath(path);
152 LoadFromNGwordFile(FNGwordpath);
153 end;
154 function TAbon.GetNGwordpath() : String;
155 begin
156 Result := FNGwordpath;
157 end;
158 //???????鴻?с???????違???????鴻???????????
159 function TAbon.Getfullpath(argpath : String) : String;
160 begin
161 if AnsiPos(':\',argpath) <> 2 then begin //?????ゃ???????????????鴻???<??????/span>
162 if Getroot() = '' then begin
163 Result := ''; //root???鴻??荐??????????????腥冴??????
164 end else begin
165 if (Froot[Length(Froot)] = '\') and (argpath[1] = '\') then begin //????????????/span>
166 Delete(argpath,1,1);
167 end;
168 Insert( Getroot(), argpath , 1);//root???鴻???水??/span>
169 Result := argpath;
170 end;
171 end else begin
172 Result := argpath;
173 end;
174
175 end;
176 //NGword???<?ゃ??????粋昭??/span>
177 function TAbon.LoadFromNGwordFile(path :String) : boolean;
178 var
179 bufstl : TStringList;
180 begin
181 path := Getfullpath(path);
182 if path = '' then begin
183 Result := false;
184 end else begin
185 bufstl := TStringList.Create;
186 try
187 try
188 bufstl.LoadFromFile(path);
189 LoadFromStringList( bufstl );
190 Result := true;
191 except
192 if CreateNGwordFile = true then begin
193 bufstl.SaveToFile(path);
194 end;
195 Result := false;
196 end;
197 finally
198 bufstl.Free;
199 end;
200 end;
201
202 end;
203 //NGword???鴻??茯??粋昭??/span>
204 procedure TAbon.LoadFromStringList( bufstl : TStringList );
205 var
206 i : integer;
207 begin
208 try
209 for i := bufstl.Count -1 downto 0 do begin
210 if bufstl.Strings[i] = '' then begin
211 bufstl.Delete(i);
212 end;
213 end;
214 SetLength(Ftokens,bufstl.Count);
215 for i := 0 to bufstl.Count -1 do begin
216 SetTokens(i , bufstl.Strings[i]);
217 end;
218
219 except
220 Exit;
221 end;
222 end;
223 //NGwordpath???≪??┃絎??????????????????????若?????∽??/span>
224 function TAbon.ReLoadFromNGwordFile() : boolean;
225 begin
226 if GetNGwordpath() ='' then begin
227 Result := false;
228 end else begin
229 Result := LoadFromNGwordFile( GetNGwordpath() );
230 end;
231 end;
232 function TAbon.Getlistpath() : String;
233 begin
234 Result := Flistpath;
235 end;
236 procedure TAbon.Setlistpath(const Value : String);
237 begin
238 Flistpath := Getfullpath(Value);
239 end;
240 //筝?茵???賢?????若???潟?????????????祉????
241 procedure TAbon.SetTokens(index: integer ; argline : String);
242 var
243 ret : Integer;
244 bufstl : TStringList;
245 i : Integer;
246 pos : Integer;
247 buftoken : String;
248 begin
249 pos := 0;
250 bufstl := TStringList.Create;
251 try
252 if Length(argline) > 0 then begin
253 pos := AnsiPos(#9,argline);
254 while pos <> 0 DO begin
255 buftoken := Copy(argline,1,pos-1);
256 Delete(argline,1,pos);
257 if Length(buftoken) > 0 then begin
258 bufstl.Append(buftoken);
259 end else if ( bufstl.Count = 0 ) then begin
260 bufstl.Append('');
261 end;
262 pos := AnsiPos(#9,argline);
263 end;
264 if Length(argline) > 0 then begin
265 bufstl.Append(argline);
266 end;
267 ret := bufstl.Count;
268 SetLength(Ftokens[index],ret);
269 for i := 0 to bufstl.Count - 1 do begin
270 Ftokens[index][i] := bufstl.Strings[i];
271 end;
272 end;
273 finally
274 bufstl.Free;
275 end;
276
277 end;
278 //Debug???<??????G???若?????障??????????
279 function TAbon.ShowAllTokens() : String;
280 var
281 i : Integer;
282 j : Integer;
283 ret : String;
284 begin
285 for i := 0 to High(Ftokens) do begin
286 for j := 0 to High(Ftokens[i]) do begin
287 ret := ret + Ftokens[i][j];
288 end;
289 end;
290 Result := ret;
291
292
293
294 end;
295 //NG???若???????障??????????true??菴?????????G???若??????違??NGwordsLineNum???ャ?????????
296 //????????????若??????????????Inbisible??true?????????
297 function TAbon.FindNGwords(const line : String; var NGwordsLineNum : Integer; var Invisible : Boolean) : Boolean; //1???ゃ?潟???ょ????
298 var
299 lines : Integer;
300 cells : Integer;
301 hit : Boolean;
302 bufline : String;
303 start : Integer;
304 begin
305 hit := false;
306 if AnsiPos(FAbonString,line) <> 1 then begin
307 for lines := 0 to High(Ftokens) do begin
308 hit := true;
309 bufline := line;
310 if Ftokens[lines][0] <> '' then begin
311 Invisible := false;
312 start := 0;
313 end else begin
314 Invisible := true;
315 start := 1;
316 end;
317
318 for cells := start to High(Ftokens[lines]) do begin
319 if AnsiPos(Ftokens[lines][cells],bufline) = 0 then begin
320 hit := false;
321 break;
322 end else begin
323 Delete(bufline,AnsiPos(Ftokens[lines][cells],bufline),Length(Ftokens[lines][cells]));
324 end;
325 end;
326 if hit = true then begin
327 NGwordsLineNum := lines + 1;
328 break;
329 end;
330 end;
331 end;
332 Result := hit;
333 end;
334 //NG???若???????障??????????true??菴?????????G???若??????違??NGwordsLineNum???ャ?????????
335 //????????????若??????????????Inbisible??true?????????
336 //??茹?????∴?
337 function TAbon.FindNGwordsEx(const line : String; var NGwordsLineNum : Integer; var Invisible : Boolean) : Boolean;//1???ゃ?潟???ょ????
338 var
339 lines : Integer;
340 cells : Integer;
341 hit : Boolean;
342 bufline : String;
343 start : Integer;
344 begin
345 hit := false;
346 if AnsiPos(FAbonString,line) <> 1 then begin
347 for lines := 0 to High(Ftokens) do begin
348 hit := true;
349 bufline := line;
350 if Ftokens[lines][0] <> '' then begin
351 Invisible := false;
352 start := 0;
353 end else begin
354 Invisible := true;
355 start := 1;
356 end;
357
358 for cells := start to High(Ftokens[lines]) do begin
359 if AnsiPos(Ftokens[lines][cells],bufline) = 0 then begin
360 hit := false;
361 break;
362 end else begin
363 Delete(bufline, AnsiPos(Ftokens[lines][cells],bufline),Length(Ftokens[lines][cells]));
364 end;
365 end;
366 if hit = true then begin
367 NGwordsLineNum := lines + 1;
368 break;
369 end;
370 end;
371 end;
372 Result := hit;
373 end;
374 //??鮎?????若???ゃ??rue??????NG???若??????????????????菴?????
375 procedure TAbon.Execute(var ThreadStrings : TStringList);
376 var
377 i : Integer;
378 NGwordsLine : Integer;
379 bufline : String;
380 invisi : Boolean;
381 begin
382 for i:=0 to ThreadStrings.Count - 1 do begin
383 NGwordsLine := 0;
384 if FindNGwords(ThreadStrings.Strings[i], NGwordsLine ,invisi) <> Reverse then begin
385 if invisi = true then begin
386 ThreadStrings.Strings[i] := '';
387 end else begin
388 if not ReturnNGwordLineNum and not SetNGResAnchor then begin
389 ThreadStrings.Strings[i] := FAbonString;
390 end else if not ReturnNGwordLineNum then begin
391 ThreadStrings.Strings[i] := Format('&nbsp;<>&nbsp;<>&nbsp;<>&gt;%d<><>',[(i+1)]);
392 end else if not SetNGResAnchor then begin
393 ThreadStrings.Strings[i] := Format('&nbsp;<>&nbsp;<>&nbsp;<><B> %d 茵?????G???若???????障???????障????</B><><>',[NGwordsLine]);
394 end else begin
395 ThreadStrings.Strings[i] := Format('&nbsp;<>&nbsp;<>&nbsp;<><B> %d 茵?????G???若???????障???????障????</B>&gt;%d <><>',[NGwordsLine,(i+1)]);
396 end;
397 end;
398 end else begin
399 bufline := ThreadStrings.Strings[i];
400 if Deleterlo = true then begin
401 bufline := CustomStringReplace(bufline,'&rlo;','');
402 bufline := CustomStringReplace(bufline,'&lro;','');
403 end;
404 if Replaceul = true then begin
405 bufline := CustomStringReplace( bufline,'<ul>','<br>' );
406 bufline := CustomStringReplace( bufline,'</ul>','<br>' );
407 end;
408 if DeleteSyria = true then
409 bufline := TreatSyria(bufline);
410 ThreadStrings.Strings[i] := bufline;
411 end;
412 end;
413 end;
414 procedure TAbon.Execute(var ResString : String; ResNumber : Integer);
415 var
416 NGwordsLine : Integer;
417 bufline : String;
418 invisi : Boolean;
419 begin
420 NGwordsLine := 0;
421 if FindNGwords(ResString, NGwordsLine ,invisi) <> Reverse then begin
422 if invisi = true then begin
423 ResString := '';
424 end else begin
425 if not ReturnNGwordLineNum and not SetNGResAnchor then begin
426 ResString := FAbonString;
427 end else if not ReturnNGwordLineNum then begin
428 ResString := Format('&nbsp;<>&nbsp;<>&nbsp;<>&gt;%d<><>',[(ResNumber)]);
429 end else if not SetNGResAnchor then begin
430 ResString := Format('&nbsp;<>&nbsp;<>&nbsp;<><B> %d 茵?????G???若???????障???????障????</B><><>',[NGwordsLine]);
431 end else begin
432 ResString := Format('&nbsp;<>&nbsp;<>&nbsp;<><B> %d 茵?????G???若???????障???????障????</B>&gt;%d <><>',[NGwordsLine,(ResNumber)]);
433 end;
434 end;
435 end else begin
436 bufline := ResString;
437 if Deleterlo = true then begin
438 bufline := CustomStringReplace( bufline,'&rlo;','' );
439 bufline := CustomStringReplace( bufline,'&lro;','' );
440 end;
441 if Replaceul = true then begin
442 bufline := CustomStringReplace( bufline,'<ul>','<br>' );
443 bufline := CustomStringReplace( bufline,'</ul>','<br>' );
444 end;
445 if DeleteSyria = true then
446 bufline := TreatSyria(bufline);
447 ResString := bufline;
448 end;
449 end;
450
451 procedure TAbon.Execute(var ThreadStrings : TStringList; NGwords : TStringList);
452 var
453 i : Integer;
454 begin
455 SetLength(Ftokens,NGwords.Count);
456 for i := 0 to NGwords.Count -1 do begin
457 SetTokens(i , NGwords.Strings[i]);
458 end;
459 Execute(ThreadStrings);
460
461 end;
462 procedure TAbon.Execute(var ThreadStrings : TStringList; NGwords : TStrings);
463 var
464 i : Integer;
465 buf : TStringList;
466 begin
467 buf := TStringList.Create;
468 buf.AddStrings(NGwords);
469 SetLength(Ftokens,buf.Count);
470 for i := 0 to buf.Count -1 do begin
471 SetTokens(i , buf.Strings[i]);
472 end;
473 Execute(ThreadStrings);
474 buf.Free;
475 end;
476
477 //??鮎?????若???ゃ??rue??????NG???若??????????????????菴?????
478 procedure TAbon.ExecuteEx(var ThreadStrings : TStringList);
479 var
480 i : Integer;
481 NGwordsLine : Integer;
482 bufline : String;
483 invisi : Boolean;
484 begin
485 for i:=0 to ThreadStrings.Count - 1 do begin
486 NGwordsLine := 0;
487 if FindNGwordsEx(ThreadStrings.Strings[i], NGwordsLine ,invisi) <> Reverse then begin
488 if invisi = true then begin
489 ThreadStrings.Strings[i] := '';
490 end else begin
491 if not ReturnNGwordLineNum and not SetNGResAnchor then begin
492 ThreadStrings.Strings[i] := FAbonString;
493 end else if not ReturnNGwordLineNum then begin
494 ThreadStrings.Strings[i] := Format('&nbsp;<>&nbsp;<>&nbsp;<>&gt;%d<><>',[(i+1)]);
495 end else if not SetNGResAnchor then begin
496 ThreadStrings.Strings[i] := Format('&nbsp;<>&nbsp;<>&nbsp;<><B> %d 茵?????G???若???????障???????障????</B><><>',[NGwordsLine]);
497 end else begin
498 ThreadStrings.Strings[i] := Format('&nbsp;<>&nbsp;<>&nbsp;<><B> %d 茵?????G???若???????障???????障????</B>&gt;%d <><>',[NGwordsLine,(i+1)]);
499 end;
500 end;
501 end else begin
502 bufline := ThreadStrings.Strings[i];
503 if Deleterlo = true then begin
504 bufline := CustomStringReplace(bufline,'&rlo;','');
505 bufline := CustomStringReplace(bufline,'&lro;','');
506 end;
507 if Replaceul = true then begin
508 bufline := CustomStringReplace( bufline,'<ul>','<br>' );
509 bufline := CustomStringReplace( bufline,'</ul>','<br>' );
510 end;
511 if DeleteSyria = true then
512 bufline := TreatSyria(bufline);
513 ThreadStrings.Strings[i] := bufline;
514 end;
515 end;
516 end;
517 procedure TAbon.ExecuteEx(var ResString : String; ResNumber : Integer);
518 var
519 NGwordsLine : Integer;
520 bufline : String;
521 invisi : Boolean;
522 begin
523 NGwordsLine := 0;
524 if FindNGwordsEx(ResString, NGwordsLine ,invisi) <> Reverse then begin
525 if invisi = true then begin
526 ResString := '';
527 end else begin
528 if not ReturnNGwordLineNum and not SetNGResAnchor then begin
529 ResString := FAbonString;
530 end else if not ReturnNGwordLineNum then begin
531 ResString := Format('&nbsp;<>&nbsp;<>&nbsp;<>&gt;%d<><>',[(ResNumber)]);
532 end else if not SetNGResAnchor then begin
533 ResString := Format('&nbsp;<>&nbsp;<>&nbsp;<><B> %d 茵?????G???若???????障???????障????</B><><>',[NGwordsLine]);
534 end else begin
535 ResString := Format('&nbsp;<>&nbsp;<>&nbsp;<><B> %d 茵?????G???若???????障???????障????</B>&gt;%d <><>',[NGwordsLine,(ResNumber)]);
536 end;
537 end;
538 end else begin
539 bufline := ResString;
540 if Deleterlo = true then begin
541 bufline := CustomStringReplace( bufline,'&rlo;','' );
542 bufline := CustomStringReplace( bufline,'&lro;','' );
543 end;
544 if Replaceul = true then begin
545 bufline := CustomStringReplace( bufline,'<ul>','<br>' );
546 bufline := CustomStringReplace( bufline,'</ul>','<br>' );
547 end;
548 if DeleteSyria = true then
549 bufline := TreatSyria(bufline);
550 ResString := bufline;
551 end;
552 end;
553
554 procedure TAbon.ExecuteEx(var ThreadStrings : TStringList; NGwords : TStringList);
555 var
556 i : Integer;
557 begin
558 SetLength(Ftokens,NGwords.Count);
559 for i := 0 to NGwords.Count -1 do begin
560 SetTokens(i , NGwords.Strings[i]);
561 end;
562 ExecuteEx(ThreadStrings);
563
564 end;
565 procedure TAbon.ExecuteEx(var ThreadStrings : TStringList; NGwords : TStrings);
566 var
567 i : Integer;
568 buf : TStringList;
569 begin
570 buf := TStringList.Create;
571 buf.AddStrings(NGwords);
572 SetLength(Ftokens,buf.Count);
573 for i := 0 to buf.Count -1 do begin
574 SetTokens(i , buf.Strings[i]);
575 end;
576 ExecuteEx(ThreadStrings);
577 buf.Free;
578 end;
579
580 //****************************************************************************//
581 //?上???祉??????????????NGword.txt??????span>
582 procedure TAbon.EditNGwords();
583 begin
584 ShellExecute(0 ,nil,PChar(FNGwordpath),nil,nil,SW_SHOW);
585 end;
586 //???????≪???????ゅ??∽??/span>
587 function TAbon.CheckAbonPopupRes(line : String) :Boolean;
588 var
589 i: Integer;
590 v: boolean;
591 begin
592 if AbonPopupRes = true then begin
593 Result := FindNGwords(line, i ,v);
594 end else begin
595 Result := false;
596 end;
597 end;
598 //茲??違??G???若???????鴻????茯??粋昭??==============================================
599 //List???<?ゃ????茯??粋昭??
600 function TAbon.LoadListFile(path :String; listStringList : TStringList) : Boolean;
601 begin
602 try
603 listStringList.LoadFromFile(path);
604 Result := true;
605 except
606 listStringList.Append('筝???NGword.txt');
607 listStringList.SaveToFile(path);
608 Result := false;
609 end;
610 end;
611 //List????ゆ???G???若?????<?ゃ????茯??粋昭??
612 function TAbon.GoForward() : Boolean;
613 begin
614 FNGwordFileIndex := FNGwordFileIndex + 1;
615 Result := ReadNGwordslist(FNGwordFileIndex);
616 end;
617 //List????ゅ????G???若?????<?ゃ????茯??粋昭??
618 function TAbon.GoBack() : Boolean;
619 begin
620 FNGwordFileIndex := FNGwordFileIndex -1;
621 Result := ReadNGwordslist(FNGwordFileIndex);
622 end;
623 //List???茵?????茯???
624 procedure TAbon.GoHome();
625 begin
626 FNGwordFileIndex := 0;
627 ReadNGwordslist(FNGwordFileIndex);
628 end;
629 //List??ine茵?????茯???
630 function TAbon.ReadNGwordslist(line : Integer) : Boolean;
631 var
632 liststl : TStringList;
633 linebuf : String;
634 begin
635 liststl := TStringList.Create;
636 try
637 if LoadListFile(Flistpath,liststl) = true then begin
638 if line < 0 then begin
639 line := liststl.Count - 1;
640 FNGwordFileIndex := liststl.Count - 1;
641 end else if line > liststl.Count - 1 then begin
642 line := 0;
643 FNGwordFileIndex := 0;
644 end;
645 linebuf := liststl.Strings[line];
646 FNGwordname := Copy(linebuf,1,AnsiPos('=',linebuf)-1);
647 Delete(linebuf,1,AnsiPos('=',linebuf));
648 SetNGwordpath(linebuf);
649 Result := true;
650 end else begin
651 Result := false;
652 end
653 finally
654 liststl.Free;
655 end;
656
657 end;
658 //茲??違??G???若???????鴻????茯??粋昭??=====?????障??================================
659 //???ャ???若????絎?茵??∽??/span>
660 procedure TAbon.IndividualAbon(var ThreadStrings : TStringList; SetResNumFile : String);
661 var
662 i : Integer;
663 begin
664 if FileExists(SetResNumFile) = true then begin
665 if LoadFromSetResNumFile(SetResNumFile) = true then begin
666 for i := 0 to High(FAbonRes) do begin
667 if (FAbonRes[i].Res <= ThreadStrings.Count) and (FAbonRes[i].Res > 0) then begin
668 if FAbonRes[i].option = 0 then begin
669 ThreadStrings.Strings[FAbonRes[i].Res-1] := '';
670 end else begin
671 ThreadStrings.Strings[FAbonRes[i].Res-1] := '???若????<>???若????<>???若????<>???若????<>';
672 end;
673 end;
674
675 end;
676 end;
677 end else begin
678 FIndividualFileName := SetResNumFile;
679 SetLength(FAbonRes,1);
680 FAbonRes[0].Res := 0;
681 FAbonRes[0].option := -1;
682 end;
683 end;
684 procedure TAbon.IndividualAbon(var ResString : String; SetResNumFile : String; ResNumber : Integer);
685 var
686 i : Integer;
687 begin
688 if FileExists(SetResNumFile) = true then begin
689 if LoadFromSetResNumFile(SetResNumFile) = true then begin
690 for i := 0 to High(FAbonRes) do begin
691 if FAbonRes[i].Res = ResNumber then begin
692 if FAbonRes[i].option = 0 then begin
693 ResString := '';
694 end else begin
695 ResString := '???若????<>???若????<>???若????<>???若????<>';
696 end;
697 Exit;
698 end;
699 end;
700 end;
701 end else begin
702 FIndividualFileName := SetResNumFile;
703 SetLength(FAbonRes,1);
704 FAbonRes[0].Res := 0;
705 FAbonRes[0].option := -1;
706 end;
707 end;
708
709 //???ャ???若???????<?ゃ????粋昭?翠?∽??/span>
710 function TAbon.LoadFromSetResNumFile(SetResNumFile : String) : Boolean;
711 var
712 bufStringList : TStringList;
713 bufLine : String;
714 i : Integer;
715 begin
716 bufStringList := TStringList.Create;
717 try
718 try
719 bufStringList.LoadFromFile(SetResNumFile);
720 FIndividualFileName := SetResNumFile;
721 //腥肴?????/span>
722 for i := bufStringList.Count-1 downto 0 do begin
723 if bufStringList.Strings[i] = '' then begin
724 bufStringList.Delete(i);
725 end;
726 end;
727
728 //?<?≪??∈篆?
729 SetLength(FAbonRes,bufStringList.Count);
730 //篁e??/span>
731 for i :=0 to bufStringList.Count - 1 do begin
732 bufLine := Trim(bufStringList.Strings[i]);
733 FAbonRes[i].Res := StrToInt(Copy(bufLine,1,AnsiPos('-',bufLine)-1));
734 FAbonRes[i].option := StrToInt(Copy(bufLine,AnsiPos('-',bufLine)+1,1));
735 end;
736 except
737 Result := false;
738 Exit;
739 end;
740 finally
741 bufStringList.Free;
742 end;
743 Result := true;
744 end;
745 //???ャ???若???????<?ゃ????申??
746 procedure TAbon.AddIndividualAbon( ResNum : Integer ; option : Integer; SetResNumFile : String);
747 var
748 IndividualFile : TStringList;
749 i, j : Integer;
750 begin
751 IndividualFile := TStringList.Create;
752 try
753 if FileExists(SetResNumFile) then begin
754 IndividualFile.LoadFromFile(SetResNumFile);
755 i := -1;
756 for j := 0 to IndividualFile.Count -1 do begin
757 if AnsiPos(IntToStr(ResNum) + '-', IndividualFile[j]) = 1 then begin
758 i := j;
759 break;
760 end;
761 end;
762 if i = -1 then
763 IndividualFile.Add(IntToStr(ResNum) + '-' + IntToStr(option))
764 else
765 IndividualFile[j] := IntToStr(ResNum) + '-' + IntToStr(option);
766
767 end else begin
768 IndividualFile.Add(IntToStr(ResNum) + '-' + IntToStr(option));
769 end;
770 IndividualFile.SaveToFile(SetResNumFile);
771 finally
772 IndividualFile.Free;
773 end;
774 end;
775 //???ャ???若???????<?ゃ??????????/span>
776 procedure TAbon.DeleteIndividualAbon( ResNum : Integer);
777 var
778 IndividualFile : TStringList;
779 linebuf : String;
780 i : Integer;
781 begin
782 IndividualFile := TStringList.Create;
783 if FAbonRes[0].Res <> 0 then begin
784 for i := 0 to High(FAbonRes) do begin
785 if FAbonRes[i].Res <> ResNum then begin
786 linebuf := IntToStr(FAbonRes[i].Res) + '-' + IntToStr(FabonRes[i].option);
787 IndividualFile.Append(linebuf);
788 end;
789 end;
790 end;
791 if IndividualFile.Count <> 0 then begin
792 try
793 IndividualFile.SaveToFile(FIndividualFileName);
794 finally
795 IndividualFile.Free;
796 end;
797 end else begin
798 if FileExists(FIndividualFileName) = true then begin
799 DeleteFile(FIndividualFileName);
800 end;
801 end;
802 end;
803 //???ャ???若?????????鴻???????違??菴???
804 function TAbon.GetAbonResCount() : Integer;
805 var
806 i : Integer;
807 begin
808 if FAbonRes[0].Res = 0 then begin
809 Result := 0
810 end else begin
811 i := High(FAbonRes);
812 Result := i+1;
813 end;
814 end;
815 //???ャ???若?????????鴻?????茵????????鴻????絖????ц???
816 function TAbon.GetAbonResString(Num : Integer) : String;
817 begin
818 if (Num <= High(FAbonRes)) and (Num >= 0) then begin
819 Result := IntToStr(FAbonRes[Num].Res);
820 end else begin
821 Result := '';
822 end;
823 end;
824 function TAbon.GetAbonResCount(SetResNumFile : String) : Integer;
825 var
826 bufStringList : TStringList;
827 begin
828 Result := 0;
829 if FileExists(SetResNumFile) then begin
830 bufStringList := TStringList.Create;
831 try
832 try
833 bufStringList.LoadFromFile(SetResNumFile);
834 Result := bufStringList.Count;
835 except
836 end;
837 finally
838 bufStringList.Free;
839 end;
840 end;
841 end;
842 procedure TAbon.DeleteIndividualAbon( ResNum : Integer; SetResNumFile : String);
843 var
844 i: Integer;
845 bufStringList : TStringList;
846 begin
847 if FileExists(SetResNumFile) then begin
848 bufStringList := TStringList.Create;
849 try
850 try
851 bufStringList.LoadFromFile(SetResNumFile);
852 i := bufStringList.IndexOf(IntToStr(ResNum)+'-');
853 if i > 0 then
854 bufStringList.Delete(i);
855 except
856 end;
857 finally
858 bufStringList.Free;
859 end;
860 end;
861 end;
862
863 //???????≪???????ゅ???/span>
864 function TAbon.CheckIndividualAbonList(ResNum : Integer) : Boolean;
865 var
866 i : Integer;
867 begin
868 if FAbonRes[0].Res <> 0 then begin
869 for i := 0 to High(FAbonRes) do begin
870 if FAbonRes[i].Res = ResNum then begin
871 Result := true;
872 Exit;
873 end;
874 end;
875 end;
876 Result := false;
877
878 end;
879 //?激???∵??????????膈?
880 function TAbon.TreatSyria(AString: string): string;
881 var
882 //count: Integer; //(&#1792~&#1871)
883 pos: Integer;
884 tmp: string;
885 begin
886 pos := AnsiPos('&#18', AString);
887 while pos <> 0 do begin
888 if StrToIntDef(Copy(AString, pos+4, 2), -1) > 0 then begin
889 if (AString[pos+6] = ';' ) or (AString[pos+6] = ' ') then begin
890 tmp := tmp + Copy(AString, 1, pos - 1);
891 Delete(AString, 1, pos+6);
892 end else if StrToIntDef(AString[pos+6], -1) = -1 then begin
893 tmp := tmp + Copy(AString, 1, pos - 1);
894 Delete(AString, 1, pos+5);
895 end else begin
896 tmp := tmp + Copy(AString, 1, pos + 5);
897 Delete(AString, 1, pos+5);
898 end;
899 end else begin
900 tmp := tmp + Copy(AString, 1, pos + 5);
901 Delete(AString, 1, pos+5);
902 end;
903 pos := AnsiPos('&#18', AString);
904 end;
905 if Length(AString) > 0 then
906 tmp := tmp + AString;
907 AString := tmp;
908 tmp := '';
909
910 pos := AnsiPos('&#179', AString);
911 while pos <> 0 do begin
912 if StrToIntDef(Copy(AString, pos+5, 1), 0) > 2 then begin
913 if (AString[pos+6] = ';') or (AString[pos+6] = ' ') then begin
914 tmp := tmp + Copy(AString, 1, pos - 1);
915 Delete(AString, 1, pos+6);
916 end else if StrToIntDef(AString[pos+6], -1) = -1 then begin
917 tmp := tmp + Copy(AString, 1, pos - 1);
918 Delete(AString, 1, pos+5);
919 end else begin
920 tmp := tmp + Copy(AString, 1, pos + 5);
921 Delete(AString, 1, pos+5);
922 end;
923 end else begin
924 tmp := tmp + Copy(AString, 1, pos + 5);
925 Delete(AString, 1, pos+5);
926 end;
927 pos := AnsiPos('&#179', AString);
928 end;
929 if Length(AString) > 0 then
930 tmp := tmp + AString;
931 Result := tmp;
932 end;
933
934
935
936 end.
937

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