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

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