Develop and Download Open Source Software

Browse CVS Repository

Contents of /gikonavigoeson/gikonavi/AbonUnit.pas

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


Revision 1.45 - (show annotations) (download) (as text)
Sun Aug 5 12:43:24 2007 UTC (16 years, 8 months ago) by h677
Branch: MAIN
CVS Tags: v1_57_0_723, v1_57_0_725, v1_57_0_726, v1_57_0_727, v1_57_0_720, v1_57_0_722, v1_57_0_728
Changes since 1.44: +27 -0 lines
File MIME type: text/x-pascal
スレッドのレス番号のポップアップメニューのこのIDをNGワードに追加機能を追加

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

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