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.46 - (show annotations) (download) (as text)
Sun Sep 2 10:50:23 2007 UTC (16 years, 7 months ago) by h677
Branch: MAIN
CVS Tags: v1_59_0_771, v1_59_0_770, v1_59_0_773, v1_59_0_772, v1_59_0_775, v1_59_0_774, v1_59_0_777, v1_59_0_776, v1_59_0_778, v1_63_1_819, v1_57_0_737, v1_62_0_812, v1_57_0_735, v1_57_0_734, v1_57_0_733, v1_57_0_732, v1_57_0_731, v1_57_0_730, v1_57_0_739, v1_57_0_738, v1_59_1_765, v1_60_0_788, v1_60_0_789, v1_58_0_748, v1_58_0_745, v1_60_0_781, v1_60_0_782, v1_58_0_746, v1_60_0_784, v1_60_0_786, v1_60_0_787, v1_59_0_767, v1_59_1_778, v1_59_0_768, v1_59_0_769, v1_57_1_744, v1_57_0_729, v1_57_0_736, v1_58_0_752, v1_58_0_750, v1_58_0_751, v1_58_0_756, v1_58_0_757, v1_58_0_754, v1_58_0_755, v1_58_0_759, v1_61_0_796, v1_61_0_797, v1_61_0_795, v1_61_0_798, v1_61_0_799, v1_63_0_818, v1_63_0_817, v1_63_0_816, v1_63_0_815, v1_62_0_805, v1_62_0_804, v1_62_0_807, v1_62_0_806, v1_62_0_803, v1_62_0_802, v1_62_0_809, v1_60_0_780, v1_60_0_779, v1_62_0_810, v1_62_0_811, v1_58_0_747, v1_60_0_783, v1_59_2_785, v1_60_1_793, v1_58_0_763, v1_58_0_762, v1_58_0_761, v1_58_0_760, v1_62_1_813, v1_57_2_749, v1_57_0_742, v1_57_0_743, v1_57_0_740, v1_57_0_741, v1_57_0_744, v1_61_0_800, v1_60_0_793, v1_60_0_792, v1_60_0_791, v1_60_0_790, v1_60_2_794, v1_61_1_801, HEAD
Branch point for: Bb57, Bb62, Bb63, Bb60, Bb61, Bb59, Bb58
Changes since 1.45: +11 -2 lines
File MIME type: text/x-pascal
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 // >> ?у??障?????若???潟???潟?<?潟???宴???х?∴?????
388 if AnsiPos('>>', buftoken) <> 1 then begin
389 bufstl.Append(buftoken);
390 end;
391 end else if ( bufstl.Count = 0 ) then begin
392 bufstl.Append('');
393 end;
394 pos := AnsiPos(#9,argline);
395 end;
396 if Length(argline) > 0 then begin
397 // >> ?у??障?????若???潟???潟?<?潟???宴???х?∴?????
398 if AnsiPos('>>', argline) <> 1 then begin
399 bufstl.Append(argline);
400 end;
401 end;
402 ret := bufstl.Count;
403 SetLength(Ftokens[index],ret);
404 for i := 0 to bufstl.Count - 1 do begin
405 if IgnoreKana then
406 Ftokens[index][i] := ZenToHan(bufstl.Strings[i])
407 else
408 Ftokens[index][i] := bufstl.Strings[i];
409 end;
410 end;
411 finally
412 bufstl.Free;
413 end;
414
415 end;
416 //Debug???<??????G???若?????障??????????
417 function TAbon.ShowAllTokens() : String;
418 var
419 i : Integer;
420 j : Integer;
421 ret : String;
422 begin
423 for i := 0 to High(Ftokens) do begin
424 for j := 0 to High(Ftokens[i]) do begin
425 ret := ret + Ftokens[i][j];
426 end;
427 end;
428 Result := ret;
429
430
431
432 end;
433 //NG???若???????障??????????true??菴?????????G???若??????違??NGwordsLineNum???ャ?????????
434 //????????????若??????????????Inbisible??true?????????
435 function TAbon.FindNGwords(const line : String; var NGwordsLineNum : Integer; var Invisible : Boolean) : Boolean; //1???ゃ?潟???ょ????
436 var
437 lines : Integer;
438 cells : Integer;
439 hit : Boolean;
440 bufline : String;
441 start : Integer;
442 target : String;
443 pos : PChar;
444 pts, pte : PChar;
445 trgLen : Integer;
446 begin
447 hit := false;
448 if AnsiStrPosEx(PChar(line), PChar(line)+Length(line), FpAbons, FpAbone) = nil then begin
449 //????茹??蚊???????∴???????
450 if IgnoreKana then
451 target := ZenToHan(line)
452 else
453 target := line;
454
455 trgLen := Length(target);
456
457 for lines := 0 to High(Ftokens) do begin
458 if Length(Ftokens[lines]) = 0 then begin
459 Continue;
460 end;
461 hit := true;
462 bufline := target;
463 pts := PChar(bufline);
464 pte := pts + trgLen;
465
466 if Ftokens[lines][0] <> '' then begin
467 Invisible := false;
468 start := 0;
469 end else begin
470 Invisible := true;
471 start := 1;
472 end;
473
474 for cells := start to High(Ftokens[lines]) do begin
475 pos := AnsiStrPosEx(pts, pte,
476 PChar(Ftokens[lines][cells]), PChar(Ftokens[lines][cells]) + Length(Ftokens[lines][cells]));
477 if pos = nil then begin
478 hit := false;
479 break;
480 end else begin
481 Delete(bufline, pos - pte + 1, Length(Ftokens[lines][cells]));
482 pts := PChar(bufline);
483 pte := pts + Length(bufline);
484 end;
485 end;
486 if hit = true then begin
487 NGwordsLineNum := lines + 1;
488 break;
489 end;
490 end;
491 end;
492 Result := hit;
493 end;
494 //??鮎?????若???ゃ??rue??????NG???若??????????????????菴?????
495 procedure TAbon.Execute(var ThreadStrings : TStringList);
496 var
497 i : Integer;
498 NGwordsLine : Integer;
499 bufline : String;
500 invisi : Boolean;
501 begin
502 for i:=0 to ThreadStrings.Count - 1 do begin
503 NGwordsLine := 0;
504 if FindNGwords(ThreadStrings.Strings[i], NGwordsLine ,invisi) <> Reverse then begin
505 if invisi = true then begin
506 ThreadStrings.Strings[i] := '';
507 end else begin
508 if not ReturnNGwordLineNum and not SetNGResAnchor then begin
509 ThreadStrings.Strings[i] := FAbonString;
510 end else if not ReturnNGwordLineNum then begin
511 ThreadStrings.Strings[i] := Format('&nbsp;<>&nbsp;<>&nbsp;<>&gt;%d<><>',[(i+1)]);
512 end else if not SetNGResAnchor then begin
513 ThreadStrings.Strings[i] := Format('&nbsp;<>&nbsp;<>&nbsp;<><B> %d 茵?????G???若???????障???????障????</B><><>',[NGwordsLine]);
514 end else begin
515 ThreadStrings.Strings[i] := Format('&nbsp;<>&nbsp;<>&nbsp;<><B> %d 茵?????G???若???????障???????障????</B>&gt;%d <><>',[NGwordsLine,(i+1)]);
516 end;
517 end;
518 end else begin
519 bufline := ThreadStrings.Strings[i];
520 if Deleterlo = true then begin
521 bufline := CustomStringReplace(bufline,'&rlo;','');
522 bufline := CustomStringReplace(bufline,'&lro;','');
523 end;
524 if Replaceul = true then begin
525 bufline := CustomStringReplace( bufline,'<ul>','<br>' );
526 bufline := CustomStringReplace( bufline,'</ul>','<br>' );
527 end;
528 if DeleteSyria = true then
529 bufline := TreatSyria(bufline);
530 ThreadStrings.Strings[i] := bufline;
531 end;
532 end;
533 end;
534 procedure TAbon.Execute(var ResString : String; ResNumber : Integer);
535 var
536 NGwordsLine : Integer;
537 bufline : String;
538 invisi : Boolean;
539 begin
540 NGwordsLine := 0;
541 if FindNGwords(ResString, NGwordsLine ,invisi) <> Reverse then begin
542 if invisi = true then begin
543 ResString := '';
544 end else begin
545 if not ReturnNGwordLineNum and not SetNGResAnchor then begin
546 ResString := FAbonString;
547 end else if not ReturnNGwordLineNum then begin
548 ResString := Format('&nbsp;<>&nbsp;<>&nbsp;<>&gt;%d<><>',[(ResNumber)]);
549 end else if not SetNGResAnchor then begin
550 ResString := Format('&nbsp;<>&nbsp;<>&nbsp;<><B> %d 茵?????G???若???????障???????障????</B><><>',[NGwordsLine]);
551 end else begin
552 ResString := Format('&nbsp;<>&nbsp;<>&nbsp;<><B> %d 茵?????G???若???????障???????障????</B>&gt;%d <><>',[NGwordsLine,(ResNumber)]);
553 end;
554 end;
555 end else begin
556 bufline := ResString;
557 if Deleterlo = true then begin
558 bufline := CustomStringReplace( bufline,'&rlo;','' );
559 bufline := CustomStringReplace( bufline,'&lro;','' );
560 end;
561 if Replaceul = true then begin
562 bufline := CustomStringReplace( bufline,'<ul>','<br>' );
563 bufline := CustomStringReplace( bufline,'</ul>','<br>' );
564 end;
565 if DeleteSyria = true then
566 bufline := TreatSyria(bufline);
567 ResString := bufline;
568 end;
569 end;
570
571
572
573 //****************************************************************************//
574 //?上???祉??????????????NGword.txt??????span>
575 procedure TAbon.EditNGwords();
576 begin
577 ShellExecute(0 ,nil,PChar(FNGwordpath),nil,nil,SW_SHOW);
578 end;
579 //???????≪???????ゅ??∽??/span>
580 function TAbon.CheckAbonPopupRes(line : String) :Boolean;
581 var
582 i: Integer;
583 v: boolean;
584 begin
585 if AbonPopupRes = true then begin
586 Result := FindNGwords(line, i ,v);
587 end else begin
588 Result := false;
589 end;
590 end;
591 //茲??違??G???若???????鴻????茯??粋昭??==============================================
592 //List???<?ゃ????茯??粋昭??
593 function TAbon.LoadListFile(path :String; listStringList : TStringList) : Boolean;
594 begin
595 try
596 listStringList.LoadFromFile(path);
597 Result := true;
598 except
599 listStringList.Append('筝???NGword.txt');
600 listStringList.SaveToFile(path);
601 Result := false;
602 end;
603 end;
604 //List????ゆ???G???若?????<?ゃ????茯??粋昭??
605 function TAbon.GoForward() : Boolean;
606 begin
607 FNGwordFileIndex := FNGwordFileIndex + 1;
608 Result := ReadNGwordslist(FNGwordFileIndex);
609 end;
610 //List????ゅ????G???若?????<?ゃ????茯??粋昭??
611 function TAbon.GoBack() : Boolean;
612 begin
613 FNGwordFileIndex := FNGwordFileIndex -1;
614 Result := ReadNGwordslist(FNGwordFileIndex);
615 end;
616 //List???茵?????茯???
617 procedure TAbon.GoHome();
618 begin
619 FNGwordFileIndex := 0;
620 ReadNGwordslist(FNGwordFileIndex);
621 end;
622 //List??ine茵?????茯???
623 function TAbon.ReadNGwordslist(line : Integer) : Boolean;
624 var
625 liststl : TStringList;
626 linebuf : String;
627 begin
628 liststl := TStringList.Create;
629 try
630 if LoadListFile(Flistpath,liststl) = true then begin
631 if line < 0 then begin
632 line := liststl.Count - 1;
633 FNGwordFileIndex := liststl.Count - 1;
634 end else if line > liststl.Count - 1 then begin
635 line := 0;
636 FNGwordFileIndex := 0;
637 end;
638 linebuf := liststl.Strings[line];
639 FNGwordname := Copy(linebuf,1,AnsiPos('=',linebuf)-1);
640 Delete(linebuf,1,AnsiPos('=',linebuf));
641 SetNGwordpath(linebuf);
642 Result := true;
643 end else begin
644 Result := false;
645 end
646 finally
647 liststl.Free;
648 end;
649
650 end;
651
652 {$IFDEF SPAM_FILTER_ENABLED}
653 procedure TAbon.Learn( resList : TStringList );
654 var
655 i, j : Integer;
656 wordCount : TWordCount;
657 spamminess : Extended;
658 indiviAbon : TIndiviAbon;
659 const
660 SPAM_THRESHOLD = 0.9;
661 begin
662
663 if GikoSys.Setting.SpamFilterAlgorithm = gsfaNone then Exit;
664 j := 0;
665 wordCount := TWordCount.Create;
666 try
667 if (FAbonRes.FLearned = 0) and (FAbonRes.Count = 0) then begin
668 // ?????????膺????ゅ???ャ???若?????????????с????er??????Щ茵????ゃ??
669 // ???ャ???若??????篏帥?c??絖??
670 FAbonRes.Sort;
671 for i := 0 to FAbonRes.Count - 1 do begin
672 while (j < resList.Count) and (j + 1 < FAbonRes[ j ].Res) do begin
673 wordCount.Clear;
674 GikoSys.Bayesian.CountWord( resList[ j ], wordCount );
675 GikoSys.Bayesian.Learn( wordCount, False );
676 Inc( j );
677 end;
678 if j < resList.Count then begin
679 wordCount.Clear;
680 GikoSys.Bayesian.CountWord( resList[ j ], wordCount );
681 GikoSys.Bayesian.Learn( wordCount, True );
682 Inc( j );
683 end;
684 end;
685
686 while j < resList.Count do begin
687 wordCount.Clear;
688 GikoSys.Bayesian.CountWord( resList[ j ], wordCount );
689 GikoSys.Bayesian.Learn( wordCount, False );
690 Inc( j );
691 end;
692 end else begin
693 // ??er??????Щ茵??с?????????с???鴻??????ィ茫??у?膺?
694 // ?紙ィ茫????????c???????翫???????若?吟?????若??????篆??????篋??у?膺???????
695 for j := FAbonRes.FLearned to resList.Count - 1 do begin
696 wordCount.Clear;
697 spamminess := GikoSys.SpamParse( resList[ j ], wordCount );
698 if spamminess >= SPAM_THRESHOLD then begin
699 // ?鴻????
700 GikoSys.Bayesian.Learn( wordCount, True );
701 indiviAbon := TIndiviAbon.Create;
702 indiviAbon.Res := j + 1;
703 indiviAbon.Option := 1;
704 FAbonRes.Add( indiviAbon );
705 end else begin
706 // ???
707 GikoSys.Bayesian.Learn( wordCount, False );
708 end;
709 end;
710 end;
711
712 FAbonRes.FLearned := resList.Count;
713 FAbonRes.Save;
714 finally
715 wordCount.Free;
716 end;
717
718 FAbonRes.Save;
719 GikoSys.Bayesian.Save;
720
721 end;
722 {$ENDIF}
723
724 //茲??違??G???若???????鴻????茯??粋昭??=====?????障??================================
725 //???ャ???若????絎?茵??∽??/span>
726 procedure TAbon.IndividualAbon(var ThreadStrings : TStringList; SetResNumFile : String);
727 var
728 i : Integer;
729 f : Boolean;
730 begin
731 f := LoadFromSetResNumFile( SetResNumFile );
732 FAbonRes.FFilePath := SetResNumFile; // Learn ???т?絖?????????/span>
733 {$IFDEF SPAM_FILTER_ENABLED}
734 Learn( ThreadStrings );
735 {$ENDIF}
736
737 if f then begin
738 for i := 0 to FAbonRes.Count - 1 do begin
739 if (FAbonRes[i].Res <= ThreadStrings.Count) and (FAbonRes[i].Res > 0) then begin
740 {$IFDEF NO_ABON}
741 ThreadStrings.Strings[FAbonRes[i].Res-1] :=
742 '<font color="red">???若????羝???lt;/font>' +
743 ThreadStrings.Strings[FAbonRes[i].Res-1];
744 {$ELSE}
745 if FAbonRes[i].option = 0 then begin
746 ThreadStrings.Strings[FAbonRes[i].Res-1] := '';
747 end else begin
748 ThreadStrings.Strings[FAbonRes[i].Res-1] := '???若????<>???若????<>???若????<>???若????<>';
749 end;
750 {$ENDIF}
751 end;
752 end;
753 end;
754 end;
755 procedure TAbon.IndividualAbon(var ResString : String; SetResNumFile : String; ResNumber : Integer);
756 var
757 i : Integer;
758 begin
759 if FileExists(SetResNumFile) = true then begin
760 if LoadFromSetResNumFile(SetResNumFile) = true then begin
761 for i := 0 to FAbonRes.Count - 1 do begin
762 if FAbonRes[i].Res = ResNumber then begin
763 if FAbonRes[i].option = 0 then begin
764 ResString := '';
765 end else begin
766 ResString := '???若????<>???若????<>???若????<>???若????<>';
767 end;
768 Exit;
769 end;
770 end;
771 end;
772 end else begin
773 FIndividualFileName := SetResNumFile;
774 FAbonRes.Free;
775 FAbonRes := TIndiviAbonList.Create;
776 end;
777 end;
778
779 //???ャ???若???????<?ゃ????粋昭?翠?∽??/span>
780 function TAbon.LoadFromSetResNumFile(SetResNumFile : String) : Boolean;
781 begin
782
783 FIndividualFileName := SetResNumFile;
784 FAbonRes.Free;
785 FAbonRes := TIndiviAbonList.Create;
786 if FileExists( SetResNumFile ) then begin
787 FAbonRes.LoadFromFile( SetResNumFile );
788 Result := true;
789 end else begin
790 Result := False;
791 end;
792
793 end;
794 //???ャ???若???????<?ゃ????申??
795 procedure TAbon.AddIndividualAbon( ResNum : Integer ; option : Integer; SetResNumFile : String);
796 var
797 IndividualFile : TStringList;
798 i, j : Integer;
799 begin
800 IndividualFile := TStringList.Create;
801 try
802 if FileExists(SetResNumFile) then begin
803 IndividualFile.LoadFromFile(SetResNumFile);
804 i := -1;
805 for j := 0 to IndividualFile.Count -1 do begin
806 if AnsiPos(IntToStr(ResNum) + '-', IndividualFile[j]) = 1 then begin
807 i := j;
808 break;
809 end;
810 end;
811 if i = -1 then
812 IndividualFile.Add(IntToStr(ResNum) + '-' + IntToStr(option))
813 else
814 IndividualFile[j] := IntToStr(ResNum) + '-' + IntToStr(option);
815
816 end else begin
817 IndividualFile.Add(IntToStr(ResNum) + '-' + IntToStr(option));
818 end;
819 IndividualFile.SaveToFile(SetResNumFile);
820 finally
821 IndividualFile.Free;
822 end;
823 end;
824
825 //???????≪???????ゅ???/span>
826 function TAbon.CheckIndividualAbonList(ResNum : Integer) : Boolean;
827 var
828 i : Integer;
829 begin
830 if (FAbonRes.Count > 0) and (FAbonRes[0].Res <> 0) then begin
831 for i := 0 to FAbonRes.Count - 1 do begin
832 if FAbonRes[i].Res = ResNum then begin
833 Result := true;
834 Exit;
835 end;
836 end;
837 end;
838 Result := false;
839
840 end;
841 //?激???∵??????????膈?
842 function TAbon.TreatSyria(AString: string): string;
843 const
844 UNI_TAG = '&#';
845 var
846 //count: Integer; //(&#1792~&#1871)
847 ps : PChar;
848 p, pe, s, se : PChar;
849 scode: String;
850 icode: Integer;
851 begin
852
853 Result := '';
854
855 p := PChar(AString);
856 pe := p + Length(AString);
857 s := PChar(UNI_TAG);
858 se := s + Length(UNI_TAG);
859
860 p := AnsiStrPosEx(p, pe, s, se);
861
862 while p <> nil do begin
863 //&#???????障?с?潟???若????
864 Result := Result + Copy(AString, 1, p - PChar(AString));
865 //&#???????障?у???ゃ????
866 Delete(AString, 1, p - PChar(AString));
867
868 //AString????絖?篁ヤ??????井?????絖????????с????/span>
869 if Length(AString) > 2 then begin
870 ps := PChar(AString) + 2;
871 if (ps^ = 'x') or (ps^ = 'X') then begin
872 //16?画;荐?
873 Inc(ps);
874 scode := '0x';
875 while ((ps^ >= '0') and (ps^ <= '9')) or
876 ((ps^ >= 'a') and (ps^ <= 'f')) or
877 ((ps^ >= 'A') and (ps^ <= 'F')) do begin
878
879 scode := scode + String(ps^);
880 Inc(ps);
881 end;
882 end else begin
883 //10?画;荐?
884 scode := '';
885 while ((ps^ >= '0') and (ps^ <= '9')) do begin
886 scode := scode + String(ps^);
887 Inc(ps);
888 end;
889 end;
890 icode := StrToIntDef(scode, 0);
891
892 //??緇???;?ч???????????????違??筝???絖????障?с??????
893 if not (ps^ = ';') then
894 Dec(ps);
895
896 //?激???∵????????????с????
897 if ( icode < 1758) or
898 ((icode > 1871) and (icode < 1958)) or
899 (icode > 1968) then begin
900 Result := Result + Copy(AString, 1, ps - PChar(AString) + 1);
901 end;
902
903 Delete(AString, 1, ps - PChar(AString) + 1);
904 end else begin
905 //緇???????絖????<?????с???????障??esult????h昭??
906 Result := Result + AString;
907 AString := '';
908 end;
909 p := PChar(AString);
910 pe := p + Length(AString);
911 p := AnsiStrPosEx(p, pe, s, se);
912 end;
913
914 //罧??c????絖?????莇潟?????????????
915 Result := Result + AString;
916 end;
917
918 // NG???若?????<?ゃ????申?? 菴遵?????????翫????True????????
919 function TAbon.AddToken(AString: string; Invisible: Boolean): Boolean;
920 var
921 bufStringList : TStringList;
922 ngword: String;
923 begin
924 Result := False;
925 if FileExists(GetNGwordpath) then begin
926 bufStringList := TStringList.Create;
927 try
928 bufStringList.LoadFromFile(GetNGwordpath);
929 if (Invisible) then begin
930 ngword := #9 + AString;
931 end else begin
932 ngword := AString;
933 end;
934 if (bufStringList.IndexOf(ngword) = -1) then begin
935 bufStringList.Add(ngword);
936 bufStringList.SaveToFile(GetNGwordpath);
937 Result := True;
938 end;
939 finally
940 bufStringList.Free;
941 end;
942 end;
943 end;
944
945
946 end.
947

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