Develop and Download Open Source Software

Browse CVS Repository

Annotation of /gikonavigoeson/gikonavi/AbonUnit.pas

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


Revision 1.37.4.1 - (hide annotations) (download) (as text)
Sat Jul 2 04:09:23 2005 UTC (18 years, 9 months ago) by h677
Branch: Bb50
Changes since 1.37: +23 -22 lines
File MIME type: text/x-pascal
シリア語ブラクラ対策の不具合の解消

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

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