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

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