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.42 - (show 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 {
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 end;
118 var
119 Abon1 :TAbon;
120 const
121 NGwordListFileName : String = 'NGwords.list';
122
123 implementation
124
125 uses MojuUtils, GikoSystem, GikoBayesian, Setting;
126
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
235 constructor TAbon.Create;
236 begin
237 // ??????
238 FAbonString := '&nbsp;<>&nbsp;<>&nbsp;<>&nbsp;&nbsp;<><>';
239 FAbonRes := TIndiviAbonList.Create;
240 FpAbons := PChar(FAbonString);
241 FpAbone := FpAbons + Length(FAbonString);
242
243 end;
244
245 destructor TAbon.Destroy;
246 begin
247 FAbonRes.Free;
248 inherited;
249 end;
250 //root??xe\config\NGwords????????
251 procedure TAbon.Setroot(root :String);
252 var
253 bufStringList : TStringList;
254 begin
255 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 end;
270 function TAbon.Getroot() : String;
271 begin
272 Result := Froot;
273 end;
274 //NGwordpath??Gword.txt??????????/span>
275 procedure TAbon.SetNGwordpath(path :String);
276 begin
277 FNGwordpath := Getfullpath(path);
278 LoadFromNGwordFile(FNGwordpath);
279 end;
280 function TAbon.GetNGwordpath() : String;
281 begin
282 Result := FNGwordpath;
283 end;
284 //???????鴻?с???????違???????鴻???????????
285 function TAbon.Getfullpath(argpath : String) : String;
286 begin
287 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
301 end;
302 //NGword???<?ゃ??????粋昭??/span>
303 function TAbon.LoadFromNGwordFile(path :String) : boolean;
304 var
305 bufstl : TStringList;
306 begin
307 path := Getfullpath(path);
308 if path = '' then begin
309 Result := false;
310 end else begin
311
312 bufstl := TStringList.Create;
313 try
314 if not FileExists(path) then begin
315 Result := false;
316 try
317 bufstl.SaveToFile(path);
318 except
319 end;
320 end else begin
321 bufstl.LoadFromFile(path);
322 LoadFromStringList( bufstl );
323 Result := true;
324 end;
325 finally
326 bufstl.Free;
327 end;
328 end;
329
330 end;
331 //NGword???鴻??茯??粋昭??/span>
332 procedure TAbon.LoadFromStringList( bufstl : TStringList );
333 var
334 i : integer;
335 begin
336 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 end;
351 //NGwordpath???≪??┃絎??????????????????????若?????∽??/span>
352 function TAbon.ReLoadFromNGwordFile() : boolean;
353 begin
354 if GetNGwordpath() ='' then begin
355 Result := false;
356 end else begin
357 Result := LoadFromNGwordFile( GetNGwordpath() );
358 end;
359 end;
360 function TAbon.Getlistpath() : String;
361 begin
362 Result := Flistpath;
363 end;
364 procedure TAbon.Setlistpath(const Value : String);
365 begin
366 Flistpath := Getfullpath(Value);
367 end;
368 //筝?茵???賢?????若???潟?????????????祉????
369 procedure TAbon.SetTokens(index: integer ; argline : String);
370 var
371 ret : Integer;
372 bufstl : TStringList;
373 i : Integer;
374 pos : Integer;
375 buftoken : String;
376 begin
377 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 if IgnoreKana then
398 Ftokens[index][i] := ZenToHan(bufstl.Strings[i])
399 else
400 Ftokens[index][i] := bufstl.Strings[i];
401 end;
402 end;
403 finally
404 bufstl.Free;
405 end;
406
407 end;
408 //Debug???<??????G???若?????障??????????
409 function TAbon.ShowAllTokens() : String;
410 var
411 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
422
423
424 end;
425 //NG???若???????障??????????true??菴?????????G???若??????違??NGwordsLineNum???ャ?????????
426 //????????????若??????????????Inbisible??true?????????
427 function TAbon.FindNGwords(const line : String; var NGwordsLineNum : Integer; var Invisible : Boolean) : Boolean; //1???ゃ?潟???ょ????
428 var
429 lines : Integer;
430 cells : Integer;
431 hit : Boolean;
432 bufline : String;
433 start : Integer;
434 target : String;
435 pos : PChar;
436 pts, pte : PChar;
437 trgLen : Integer;
438 begin
439 hit := false;
440 if AnsiStrPosEx(PChar(line), PChar(line)+Length(line), FpAbons, FpAbone) = nil then begin
441 //????茹??蚊???????∴???????
442 if IgnoreKana then
443 target := ZenToHan(line)
444 else
445 target := line;
446
447 trgLen := Length(target);
448
449 for lines := 0 to High(Ftokens) do begin
450 hit := true;
451 bufline := target;
452 pts := PChar(bufline);
453 pte := pts + trgLen;
454
455 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 pos := AnsiStrPosEx(pts, pte,
465 PChar(Ftokens[lines][cells]), PChar(Ftokens[lines][cells]) + Length(Ftokens[lines][cells]));
466 if pos = nil then begin
467 hit := false;
468 break;
469 end else begin
470 Delete(bufline, pos - pte + 1, Length(Ftokens[lines][cells]));
471 pts := PChar(bufline);
472 pte := pts + Length(bufline);
473 end;
474 end;
475 if hit = true then begin
476 NGwordsLineNum := lines + 1;
477 break;
478 end;
479 end;
480 end;
481 Result := hit;
482 end;
483 //??鮎?????若???ゃ??rue??????NG???若??????????????????菴?????
484 procedure TAbon.Execute(var ThreadStrings : TStringList);
485 var
486 i : Integer;
487 NGwordsLine : Integer;
488 bufline : String;
489 invisi : Boolean;
490 begin
491 for i:=0 to ThreadStrings.Count - 1 do begin
492 NGwordsLine := 0;
493 if FindNGwords(ThreadStrings.Strings[i], NGwordsLine ,invisi) <> Reverse then begin
494 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 end;
523 procedure TAbon.Execute(var ResString : String; ResNumber : Integer);
524 var
525 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 end;
559
560
561
562 //****************************************************************************//
563 //?上???祉??????????????NGword.txt??????span>
564 procedure TAbon.EditNGwords();
565 begin
566 ShellExecute(0 ,nil,PChar(FNGwordpath),nil,nil,SW_SHOW);
567 end;
568 //???????≪???????ゅ??∽??/span>
569 function TAbon.CheckAbonPopupRes(line : String) :Boolean;
570 var
571 i: Integer;
572 v: boolean;
573 begin
574 if AbonPopupRes = true then begin
575 Result := FindNGwords(line, i ,v);
576 end else begin
577 Result := false;
578 end;
579 end;
580 //茲??違??G???若???????鴻????茯??粋昭??==============================================
581 //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 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 var
614 liststl : TStringList;
615 linebuf : String;
616 begin
617 liststl := TStringList.Create;
618 try
619 if LoadListFile(Flistpath,liststl) = true then begin
620 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 FNGwordFileIndex := 0;
626 end;
627 linebuf := liststl.Strings[line];
628 FNGwordname := Copy(linebuf,1,AnsiPos('=',linebuf)-1);
629 Delete(linebuf,1,AnsiPos('=',linebuf));
630 SetNGwordpath(linebuf);
631 Result := true;
632 end else begin
633 Result := false;
634 end
635 finally
636 liststl.Free;
637 end;
638
639 end;
640
641 {$IFDEF SPAM_FILTER_ENABLED}
642 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 if GikoSys.Setting.SpamFilterAlgorithm = gsfaNone then Exit;
653 j := 0;
654 wordCount := TWordCount.Create;
655 try
656 if (FAbonRes.FLearned = 0) and (FAbonRes.Count = 0) then begin
657 // ?????????膺????ゅ???ャ???若?????????????с????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 spamminess := GikoSys.SpamParse( resList[ j ], wordCount );
687 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 {$ENDIF}
712
713 //茲??違??G???若???????鴻????茯??粋昭??=====?????障??================================
714 //???ャ???若????絎?茵??∽??/span>
715 procedure TAbon.IndividualAbon(var ThreadStrings : TStringList; SetResNumFile : String);
716 var
717 i : Integer;
718 f : Boolean;
719 begin
720 f := LoadFromSetResNumFile( SetResNumFile );
721 FAbonRes.FFilePath := SetResNumFile; // Learn ???т?絖?????????/span>
722 {$IFDEF SPAM_FILTER_ENABLED}
723 Learn( ThreadStrings );
724 {$ENDIF}
725
726 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 {$IFDEF NO_ABON}
730 ThreadStrings.Strings[FAbonRes[i].Res-1] :=
731 '<font color="red">???若????羝???lt;/font>' +
732 ThreadStrings.Strings[FAbonRes[i].Res-1];
733 {$ELSE}
734 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 {$ENDIF}
740 end;
741 end;
742 end;
743 end;
744 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 for i := 0 to FAbonRes.Count - 1 do begin
751 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 FIndividualFileName := SetResNumFile;
763 FAbonRes.Free;
764 FAbonRes := TIndiviAbonList.Create;
765 end;
766 end;
767
768 //???ャ???若???????<?ゃ????粋昭?翠?∽??/span>
769 function TAbon.LoadFromSetResNumFile(SetResNumFile : String) : Boolean;
770 begin
771
772 FIndividualFileName := SetResNumFile;
773 FAbonRes.Free;
774 FAbonRes := TIndiviAbonList.Create;
775 if FileExists( SetResNumFile ) then begin
776 FAbonRes.LoadFromFile( SetResNumFile );
777 Result := true;
778 end else begin
779 Result := False;
780 end;
781
782 end;
783 //???ャ???若???????<?ゃ????申??
784 procedure TAbon.AddIndividualAbon( ResNum : Integer ; option : Integer; SetResNumFile : String);
785 var
786 IndividualFile : TStringList;
787 i, j : Integer;
788 begin
789 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 end;
813
814 //???????≪???????ゅ???/span>
815 function TAbon.CheckIndividualAbonList(ResNum : Integer) : Boolean;
816 var
817 i : Integer;
818 begin
819 if (FAbonRes.Count > 0) and (FAbonRes[0].Res <> 0) then begin
820 for i := 0 to FAbonRes.Count - 1 do begin
821 if FAbonRes[i].Res = ResNum then begin
822 Result := true;
823 Exit;
824 end;
825 end;
826 end;
827 Result := false;
828
829 end;
830 //?激???∵??????????膈?
831 function TAbon.TreatSyria(AString: string): string;
832 const
833 UNI_TAG = '&#';
834 var
835 //count: Integer; //(&#1792~&#1871)
836 ps : PChar;
837 p, pe, s, se : PChar;
838 scode: String;
839 icode: Integer;
840 begin
841
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 end else begin
872 //10?画;荐?
873 scode := '';
874 while ((ps^ >= '0') and (ps^ <= '9')) do begin
875 scode := scode + String(ps^);
876 Inc(ps);
877 end;
878 end;
879 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 end else begin
891 //緇???????絖????<?????с???????障??esult????h昭??
892 Result := Result + AString;
893 AString := '';
894 end;
895 p := PChar(AString);
896 pe := p + Length(AString);
897 p := AnsiStrPosEx(p, pe, s, se);
898 end;
899
900 //罧??c????絖?????莇潟?????????????
901 Result := Result + AString;
902 end;
903
904
905
906 end.
907

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