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.39 - (hide annotations) (download) (as text)
Sun Aug 21 09:57:15 2005 UTC (18 years, 8 months ago) by h677
Branch: MAIN
Changes since 1.38: +2 -2 lines
File MIME type: text/x-pascal
ネセウムチエウムフ荀?ハ、、、隍ヲ、ヒハムケケ

1 yoffy 1.37 {
2     NO_ABON 縺ゅ⊂繝シ繧捺ク医∩縺ョ繝ャ繧ケ繧り。ィ遉コ縺吶k(蠑キ隱ソ縺輔l繧?
3     SPAM_FILTER_ENABLED 繧ケ繝代Β繝輔ぅ繝ォ繧ソ繧呈ゥ溯?縺輔○繧?/span>
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:騾壼クク縺ゅ⊂繝シ繧?/span>
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; //!< 繝輔ぃ繧、繝ォ繝代せ
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 螳」險? }
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;繧ょ炎繧?/span>
50 h677 1.3 FReplaceul :Boolean ; //<ul>繧ソ繧ー繧?lt;br>繧ソ繧ー縺ォ鄂ョ謠帙☆繧九°
51     FReverse : Boolean ; //NG繝ッ繝シ繝峨〒縺ョ縺ゅ⊂縲懊s縺ョ邨先棡繧貞渚霆「縺輔○繧九°
52     FAbonPopupRes : Boolean; //繝ャ繧ケ繝昴ャ繝励い繝??縺ョ譎ゅ↓縺ゅ⊂繝シ繧薙☆繧九°
53 h677 1.29 FNGwordFileIndex : Integer; //迴セ蝨ィ隱ュ縺ソ霎シ繧薙〒繧起G繝ッ繝シ繝峨′list縺ョ菴戊。檎岼縺?/span>
54 h677 1.9 FNGwordname : String; //迴セ蝨ィ隱ュ縺ソ霎シ繧薙〒繧起G繝ッ繝シ繝峨?陦ィ遉コ蜷?/span>
55 h677 1.11 FIndividualFileName : String; //蛟句挨縺ゅ⊂縲懊s縺ョ繝輔ぃ繧、繝ォ蜷?/span>
56 h677 1.16 FReturnNGwordLineNum : Boolean; //NG繝ッ繝シ繝峨?陦梧焚繧定ソ斐☆縲?/span>
57     FSetNGResAnchor : Boolean; //NG縺ォ隧イ蠖薙@縺溘→縺阪↓譛ャ譁?↓縺昴?繝ャ繧ケ縺ク縺ョ繝ャ繧ケ繧「繝ウ繧ォ繝シ繧偵▽縺代k縺九←縺?°
58 yoffy 1.30 FDeleteSyria: Boolean; //繧キ繝ェ繧「隱槭ヶ繝ゥ繧ッ繝ゥ蟇セ遲厄シ?amp;#1792~&#1871??/span>
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 螳」險? }
67     constructor Create; // 繧ウ繝ウ繧ケ繝医Λ繧ッ繧ソ
68     destructor Destroy; override; // 繝?せ繝医Λ繧ッ繧ソ
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繝ゥ繧、繝ウ縺壹▽逕ィ縲?/span>
91 h677 1.24 //縺ゅ⊂縲懊s蜃ヲ逅?NG繝ッ繝シ繝峨〒縺ョ繝輔ぅ繝ォ繧ソ繝ェ繝ウ繧ー)
92     procedure Execute(var ThreadStrings : TStringList); overload;
93     procedure Execute(var ResString : String; ResNumber : Integer); overload; //荳サ縺ォplugin縺九i縺ョDat To HTML 逕ィ
94    
95 yoffy 1.37 {$IFDEF SPAM_FILTER_ENABLED}
96 yoffy 1.30 //! 繧ケ繝代Β繝輔ぅ繝ォ繧ソ縺ョ蟄ヲ鄙?/span>
97     procedure Learn( resList : TStringList );
98 yoffy 1.37 {$ENDIF}
99 h677 1.24 //蛟句挨縺ゅ⊂縲懊s縺励g繧?/span>
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繧帝幕縺上??/span>
106 h677 1.24 function ShowAllTokens() : String; //繝?ヰ繝?げ逕ィ
107     //--
108     procedure GoHome();//List縺ョ?題。檎岼繧定ェュ繧?
109     function GoForward() : Boolean; //List縺ョ荳?縺、谺。縺ョNG繝ッ繝シ繝峨ヵ繧。繧、繝ォ繧定ェュ縺ソ霎シ繧?
110     function GoBack() : Boolean; //List縺ョ荳?縺、蜑阪?NG繝ッ繝シ繝峨ヵ繧。繧、繝ォ繧定ェュ縺ソ霎シ繧?
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     //遨コ陦悟炎髯、
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     //莉」蜈・
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 // 蛻晄悄蛹?/span>
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縺ッExe\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縺ッNGword.txt縺ョ繝輔Ν繝代せ
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 //繝輔Ν繝代せ縺ァ縺ェ縺代l縺ー繝輔Ν繝代せ縺ォ縺励※霑斐☆縲?/span>
279     function TAbon.Getfullpath(argpath : String) : String;
280     begin
281 h677 1.24 if AnsiPos(':\',argpath) <> 2 then begin //繝峨Λ繧、繝悶°繧峨?繝輔Ν繝代せ縺檎┌縺代l縺ー
282     if Getroot() = '' then begin
283     Result := ''; //root繝代せ縺瑚ィュ螳壹&繧後※縺ェ縺?°遨コ縺ォ縺吶k
284     end else begin
285     if (Froot[Length(Froot)] = '\') and (argpath[1] = '\') then begin //蜈磯?ュ縺ョ\繧貞炎髯、
286     Delete(argpath,1,1);
287     end;
288     Insert( Getroot(), argpath , 1);//root繝代せ繧呈諺蜈・
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繝輔ぃ繧、繝ォ縺ョ隱ュ縺ソ霎シ縺ソ
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繝ェ繧ケ繝郁ェュ縺ソ霎シ縺ソ
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縺梧里縺ォ險ュ螳壹&繧後※縺?k縺ィ縺阪?繝ェ繝ュ繝シ繝臥畑髢「謨ー
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 h677 1.39 Ftokens[index][i] := ZenToHan(bufstl.Strings[i]);
393 h677 1.24 end;
394     end;
395     finally
396     bufstl.Free;
397     end;
398 h677 1.1
399     end;
400 h677 1.8 //Debug逕ィ縺。繧?s縺ィNG繝ッ繝シ繝峨r諡セ縺医※縺?k縺?/span>
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繝ッ繝シ繝峨′蜷ォ縺セ繧後※縺?◆繧液rue繧定ソ斐@縲√◎縺ョNG繝ッ繝シ繝峨?陦梧焚繧誰GwordsLineNum縺ォ蜈・繧後※霑斐☆縲?/span>
418     //繧ゅ@繧る?乗?縺ゅ⊂縲懊s縺ォ縺吶k縺ェ繧迂nbisible繧稚rue縺ォ縺励※霑斐☆
419     function TAbon.FindNGwords(const line : String; var NGwordsLineNum : Integer; var Invisible : Boolean) : Boolean; //1繝ゥ繧、繝ウ縺壹▽逕ィ縲?/span>
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 h677 1.39 bufline := ZenToHan(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 //譛ォ蟆セ縺ョ繝悶?繝ォ蛟、縺ッtrue縺?縺ィ縲¨G繝ッ繝シ繝峨r蜷ォ繧?繧ゅ?縺?縺代r霑斐☆縲?/span>
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 陦檎岼縺ョNG繝ッ繝シ繝峨′蜷ォ縺セ繧後※縺?∪縺吶??lt;/B><><>',[NGwordsLine]);
476     end else begin
477     ThreadStrings.Strings[i] := Format('&nbsp;<>&nbsp;<>&nbsp;<><B> %d 陦檎岼縺ョNG繝ッ繝シ繝峨′蜷ォ縺セ繧後※縺?∪縺吶??lt;/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 陦檎岼縺ョNG繝ッ繝シ繝峨′蜷ォ縺セ繧後※縺?∪縺吶??lt;/B><><>',[NGwordsLine]);
513     end else begin
514     ResString := Format('&nbsp;<>&nbsp;<>&nbsp;<><B> %d 陦檎岼縺ョNG繝ッ繝シ繝峨′蜷ォ縺セ繧後※縺?∪縺吶??lt;/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     //迴セ蝨ィ繧サ繝?ヨ縺輔l縺ヲ縺?kNGword.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 //繝昴ャ繝励い繝??逕ィ蛻、螳夐未謨ー
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 //隍?焚縺ョNG繝ッ繝シ繝峨ユ繧ュ繧ケ繝医r隱ュ縺ソ霎シ繧?==============================================
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縺ョ荳?縺、谺。縺ョNG繝ッ繝シ繝峨ヵ繧。繧、繝ォ繧定ェュ縺ソ霎シ繧?
567     function TAbon.GoForward() : Boolean;
568 h677 1.10 begin
569     FNGwordFileIndex := FNGwordFileIndex + 1;
570     Result := ReadNGwordslist(FNGwordFileIndex);
571     end;
572     //List縺ョ荳?縺、蜑阪?NG繝ッ繝シ繝峨ヵ繧。繧、繝ォ繧定ェュ縺ソ霎シ繧?
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縺ョline陦檎岼繧定ェュ繧?
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 // 蛻昴a縺ヲ縺ョ蟄ヲ鄙偵°縺、蛟句挨縺ゅ⊂縲懊s縺ゅj縺ェ縺ョ縺ァ縲∵立ver縺九i縺ョ遘サ陦後↓縺、縺?/span>
631     // 蛟句挨縺ゅ⊂縲懊s繧剃スソ縺」縺溷ュヲ鄙?/span>
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     // 譌ァver縺九i縺ョ遘サ陦後〒縺ッ縺ェ縺??縺ァ繝ャ繧ケ繧貞?縺ヲ謗ィ隲悶〒蟄ヲ鄙?/span>
656     // 窶サ謗ィ隲悶′髢馴&縺」縺ヲ縺?k蝣エ蜷医?繝ヲ繝シ繧カ縺後≠縺シ縲懊s繧剃ソョ豁」縺吶k莠九〒蟄ヲ鄙偵&繧後k
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 //隍?焚縺ョNG繝ッ繝シ繝峨ユ繧ュ繧ケ繝医r隱ュ縺ソ霎シ繧?=====縺薙%縺セ縺ァ=================================
687 h677 1.11 //蛟句挨縺ゅ⊂縲懊s螳溯。碁未謨ー
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 縺ッ縺ァ菫晏ュ倥☆繧九?縺ァ
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">縺ゅ⊂縲懊s貂医∩</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] := '縺ゅ⊂縲懊s<>縺ゅ⊂縲懊s<>縺ゅ⊂縲懊s<>縺ゅ⊂縲懊s<>';
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 := '縺ゅ⊂縲懊s<>縺ゅ⊂縲懊s<>縺ゅ⊂縲懊s<>縺ゅ⊂縲懊s<>';
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 //蛟句挨縺ゅ⊂縲懊s繝輔ぃ繧、繝ォ隱ュ縺ソ霎シ縺ソ髢「謨ー
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     //蛟句挨縺ゅ⊂縲懊s繝輔ぃ繧、繝ォ縺ォ霑ス蜉?
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 //繝昴ャ繝励い繝??縺ョ蛻、螳夂畑
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     //繧キ繝ェ繧「隱槭ヶ繝ゥ繧ッ繝ゥ蟇セ遲?/span>
804     function TAbon.TreatSyria(AString: string): string;
805 h677 1.38 const
806     UNI_TAG = '&#';
807 h677 1.22 var
808     //count: Integer; //(&#1792~&#1871)
809 h677 1.38 ps : PChar;
810     p, pe, s, se : PChar;
811     scode: String;
812     icode: Integer;
813 h677 1.22 begin
814 h677 1.38
815     Result := '';
816    
817     p := PChar(AString);
818     pe := p + Length(AString);
819     s := PChar(UNI_TAG);
820     se := s + Length(UNI_TAG);
821    
822     p := AnsiStrPosEx(p, pe, s, se);
823    
824     while p <> nil do begin
825     //&#縺ョ謇句燕縺セ縺ァ繧ウ繝斐?縺吶k
826     Result := Result + Copy(AString, 1, p - PChar(AString));
827     //&#縺ョ謇句燕縺セ縺ァ蜑企勁縺吶k
828     Delete(AString, 1, p - PChar(AString));
829    
830     //AString縺ォ3譁?ュ嶺サ・荳翫≠繧後?谺。縺ョ3譁?ュ礼岼繧偵メ繧ァ繝?け
831     if Length(AString) > 2 then begin
832     ps := PChar(AString) + 2;
833     if (ps^ = 'x') or (ps^ = 'X') then begin
834     //16騾イ陦ィ險?/span>
835     Inc(ps);
836     scode := '0x';
837     while ((ps^ >= '0') and (ps^ <= '9')) or
838     ((ps^ >= 'a') and (ps^ <= 'f')) or
839     ((ps^ >= 'A') and (ps^ <= 'F')) do begin
840    
841     scode := scode + String(ps^);
842     Inc(ps);
843     end;
844 h677 1.27 end else begin
845 h677 1.38 //10騾イ陦ィ險?/span>
846     scode := '';
847     while ((ps^ >= '0') and (ps^ <= '9')) do begin
848     scode := scode + String(ps^);
849     Inc(ps);
850     end;
851 h677 1.27 end;
852 h677 1.38 icode := StrToIntDef(scode, 0);
853    
854     //譛?蠕後′;縺ァ髢峨§縺ヲ縺?↑縺代l縺ー縲∽ク?譁?ュ怜燕縺セ縺ァ縺ォ縺吶k
855     if not (ps^ = ';') then
856     Dec(ps);
857    
858     //繧キ繝ェ繧「隱槭ヶ繝ゥ繧ッ繝ゥ縺ョ縺ァ縺ェ縺?/span>
859     if (icode <1792) or (icode > 1871) then
860     Result := Result + Copy(AString, 1, ps - PChar(AString) + 1);
861    
862     Delete(AString, 1, ps - PChar(AString) + 1);
863 h677 1.27 end else begin
864 h677 1.38 //蠕後m縺ォ譁?ュ励′辟。縺??縺ァ縲√◎縺ョ縺セ縺セResult縺ォ遯√▲霎シ繧?
865     Result := Result + AString;
866     AString := '';
867 h677 1.27 end;
868 h677 1.38 p := PChar(AString);
869     pe := p + Length(AString);
870     p := AnsiStrPosEx(p, pe, s, se);
871 h677 1.27 end;
872 h677 1.38
873     //谿九▲縺滓枚蟄怜?繧定カウ縺励※邨先棡縺ォ縺吶k
874     Result := Result + AString;
875 h677 1.11 end;
876 h677 1.28
877    
878    
879 h677 1.1 end.
880    

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