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.34 - (hide annotations) (download) (as text)
Thu Oct 21 09:04:26 2004 UTC (19 years, 6 months ago) by yoffy
Branch: MAIN
Changes since 1.33: +1 -1 lines
File MIME type: text/x-pascal
レスポップアップ時にエラーを起こす事があったので修正。

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

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