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

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