Develop and Download Open Source Software

Browse CVS Repository

Diff of /gikonavigoeson/gikonavi/AbonUnit.pas

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

revision 1.17.2.3 by yoffy, Fri Oct 8 05:44:48 2004 UTC revision 1.46 by h677, Sun Sep 2 10:50:23 2007 UTC
# Line 1  Line 1 
1    {
2    NO_ABON                                                 あぼーん済みのレスも表示する(強調される)
3    SPAM_FILTER_ENABLED     スパムフィルタを機能させる
4    }
5    
6  unit AbonUnit;  unit AbonUnit;
7    
8  interface  interface
# Line 5  uses Line 10  uses
10      Windows,Messages, ShellAPI, SysUtils, Classes,StdCtrls,StrUtils;      Windows,Messages, ShellAPI, SysUtils, Classes,StdCtrls,StrUtils;
11    
12  type  type
13    TIndiviAbon = record          TIndiviAbon = class( TObject )
14          Res: Integer;          private
15      option: Integer; // 0:透明 1:通常あぼーん                  FRes: Integer;
16    end;                  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;               //!< ファイルパス
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)    TAbon = class(TObject)
41    private    private
42      { Private 宣言 }          { Private 宣言 }
43      Froot : String;          Froot : String;
44      Flistpath : String;          Flistpath : String;
45      FNGwordpath : String;          FNGwordpath : String;
46      Ftokens : array of array of string;          Ftokens : array of array of string;
47      FAbonRes : array of TIndiviAbon;          FAbonRes : TIndiviAbonList;
48      FAbonString : String;          FAbonString : String;
49  //    FCutoffNum : Integer; //この数以上連続する同じ英字をNGワードとする          FpAbons : PChar;
50      FDeleterlo : Boolean; //&rlo;を削るか //追加&lro;も削る          FpAbone : PChar;
51      FReplaceul :Boolean ; //<ul>タグを<br>タグに置換するか          FDeleterlo : Boolean; //&rlo;を削るか //追加&lro;も削る
52      FReverse : Boolean ;  //NGワードでのあぼ〜んの結果を反転させるか          FReplaceul :Boolean ; //<ul>タグを<br>タグに置換するか
53      FAbonPopupRes : Boolean; //レスポップアップの時にあぼーんするか          FReverse : Boolean ;  //NGワードでのあぼ〜んの結果を反転させるか
54      FCreateNGwordFile : Boolean; //指定されたpathにNGワードtxtが無かったときに自動的に生成するか          FAbonPopupRes : Boolean; //レスポップアップの時にあぼーんするか
55      FNGwordFileIndex : Integer; //現在読み込んでるNGワードがlistの何行目か          FNGwordFileIndex : Integer; //現在読み込んでるNGワードがlistの何行目か
56      FNGwordname : String; //現在読み込んでるNGワードの表示名          FNGwordname : String; //現在読み込んでるNGワードの表示名
57      FIndividualFileName : String;       //個別あぼ〜んのファイル名          FIndividualFileName : String;   //個別あぼ〜んのファイル名
58      FReturnNGwordLineNum : Boolean;     //NGワードの行数を返す。          FReturnNGwordLineNum : Boolean; //NGワードの行数を返す。
59      FSetNGResAnchor : Boolean; //NGに該当したときに本文にそのレスへのレスアンカーをつけるかどうか          FSetNGResAnchor : Boolean; //NGに該当したときに本文にそのレスへのレスアンカーをつけるかどうか
60      FDeleteSyria: Boolean;      //シリア語ブラクラ対策(&#1792~&#1871)          FDeleteSyria: Boolean;  //シリア語ブラクラ対策(&#1792~&#1871)
61      procedure SetTokens(index: integer ; argline:String);          FIgnoreKana: Boolean;   //全角半角ひらがなカタカナの違いを無視するか
62      function Getlistpath() : String;          procedure SetTokens(index: integer ; argline:String);
63      procedure Setlistpath(const Value : String);          function Getlistpath() : String;
64      function LoadListFile(path :String;listStringList : TStringList) : Boolean;          procedure Setlistpath(const Value : String);
65      function ReadNGwordslist(line : Integer) : Boolean;          function LoadListFile(path :String;listStringList : TStringList) : Boolean;
66      function LoadFromSetResNumFile(SetResNumFile : String) : Boolean;          function ReadNGwordslist(line : Integer) : Boolean;
67            function LoadFromSetResNumFile(SetResNumFile : String) : Boolean;
68    public    public
69      { Public 宣言 }          { Public 宣言 }
70      constructor Create; // コンストラクタ          constructor Create; // コンストラクタ
71      destructor Destroy; override; // デストラクタ          destructor Destroy; override; // デストラクタ
72      property Deleterlo: Boolean read FDeleterlo write FDeleterlo  default false;          property Deleterlo: Boolean read FDeleterlo write FDeleterlo  default false;
73      property Replaceul: Boolean read FReplaceul write FReplaceul  default false;          property Replaceul: Boolean read FReplaceul write FReplaceul  default false;
74      property Reverse: Boolean read FReverse write FReverse  default false;          property Reverse: Boolean read FReverse write FReverse  default false;
75      property CreateNGwordFile: Boolean read FCreateNGwordFile write FCreateNGwordFile;          property AbonString : String read FAbonString write FAbonString;
76      property AbonString : String read FAbonString write FAbonString;          property  AbonPopupRes : Boolean read FAbonPopupRes write FAbonPopupRes default false;
77      property  AbonPopupRes : Boolean read FAbonPopupRes write FAbonPopupRes default false;          property listpath : String read Getlistpath write Setlistpath;
78      property listpath : String read Getlistpath write Setlistpath;          property NGwordFileIndex : Integer read FNGwordFileIndex write FNGwordFileIndex default 0;
79      property NGwordFileIndex : Integer read FNGwordFileIndex write FNGwordFileIndex default 0;          property NGwordname : String read FNGwordname write FNGwordname;
     property NGwordname : String read FNGwordname write FNGwordname;  
80          property ReturnNGwordLineNum : Boolean read FReturnNGwordLineNum write FReturnNGwordLineNum default false;          property ReturnNGwordLineNum : Boolean read FReturnNGwordLineNum write FReturnNGwordLineNum default false;
81      property SetNGResAnchor : Boolean read FSetNGResAnchor write FSetNGResAnchor default false;          property SetNGResAnchor : Boolean read FSetNGResAnchor write FSetNGResAnchor default false;
82      property DeleteSyria : Boolean read FDeleteSyria write FDeleteSyria default false;          property DeleteSyria : Boolean read FDeleteSyria write FDeleteSyria default false;
83      procedure Setroot(root :String);          property IgnoreKana: Boolean read FIgnoreKana write FIgnoreKana default false;
84      function Getroot() : String;          procedure Setroot(root :String);
85            function Getroot() : String;
86      function Getfullpath(argpath : String) : String;  
87      procedure SetNGwordpath(path :String);          function Getfullpath(argpath : String) : String;
88      function GetNGwordpath() : String;          procedure SetNGwordpath(path :String);
89      function LoadFromNGwordFile(path :String) : Boolean;          function GetNGwordpath() : String;
90      function ReLoadFromNGwordFile() : Boolean;          function LoadFromNGwordFile(path :String) : Boolean;
91      procedure LoadFromStringList( bufstl : TStringList );          function ReLoadFromNGwordFile() : Boolean;
92      function CheckAbonPopupRes(line : String) :Boolean;          procedure LoadFromStringList( bufstl : TStringList );
93            function CheckAbonPopupRes(line : String) :Boolean;
94          function FindNGwords(const line : String; var NGwordsLineNum : Integer; var Invisible : Boolean) : Boolean;//1ラインずつ用。          function FindNGwords(const line : String; var NGwordsLineNum : Integer; var Invisible : Boolean) : Boolean;//1ラインずつ用。
         function FindNGwordsEx(const line : String; var NGwordsLineNum : Integer; var Invisible : Boolean) : Boolean;//1ラインずつ用。  
95          //あぼ〜ん処理(NGワードでのフィルタリング)          //あぼ〜ん処理(NGワードでのフィルタリング)
96          procedure Execute(var ThreadStrings : TStringList); overload;          procedure Execute(var ThreadStrings : TStringList); overload;
         procedure Execute(var ThreadStrings : TStringList; NGwords : TStringList); overload;  
         procedure Execute(var ThreadStrings : TStringList; NGwords : TStrings); overload;  
97          procedure Execute(var ResString : String; ResNumber : Integer); overload;       //主にpluginからのDat To HTML 用          procedure Execute(var ResString : String; ResNumber : Integer); overload;       //主にpluginからのDat To HTML 用
         procedure ExecuteEx(var ThreadStrings : TStringList); overload;  
         procedure ExecuteEx(var ThreadStrings : TStringList; NGwords : TStringList); overload;  
         procedure ExecuteEx(var ThreadStrings : TStringList; NGwords : TStrings); overload;  
         procedure ExecuteEx(var ResString : String; ResNumber : Integer); overload;     //主にpluginからのDat To HTML 用  
98    
99    {$IFDEF SPAM_FILTER_ENABLED}
100            //! スパムフィルタの学習
101            procedure Learn( resList : TStringList );
102    {$ENDIF}
103          //個別あぼ〜んしょり          //個別あぼ〜んしょり
104          procedure IndividualAbon(var ThreadStrings : TStringList; SetResNumFile : String); overload;          procedure IndividualAbon(var ThreadStrings : TStringList; SetResNumFile : String); overload;
105          procedure IndividualAbon(var ResString : String; SetResNumFile : String; ResNumber : Integer); overload;          procedure IndividualAbon(var ResString : String; SetResNumFile : String; ResNumber : Integer); overload;
106          procedure AddIndividualAbon( ResNum : Integer ; option : Integer);          procedure AddIndividualAbon( ResNum : Integer ; option : Integer; SetResNumFile : String);
         procedure DeleteIndividualAbon( ResNum : Integer);  
         function GetAbonResCount() : Integer;  
         function GetAbonResString(Num : Integer) : String;  
107          function CheckIndividualAbonList(ResNum : Integer) : Boolean;          function CheckIndividualAbonList(ResNum : Integer) : Boolean;
108    
109          procedure EditNGwords();  //NGword.txtを開く。          procedure EditNGwords();  //NGword.txtを開く。
# Line 92  type Line 114  type
114          function GoBack() : Boolean; //Listの一つ前のNGワードファイルを読み込む          function GoBack() : Boolean; //Listの一つ前のNGワードファイルを読み込む
115          //--          //--
116          function TreatSyria(AString: string): string;          function TreatSyria(AString: string): string;
117        //--
118        function AddToken(AString: string; Invisible: Boolean): Boolean;
119    end;    end;
120  var  var
121          Abon1 :TAbon;          Abon1 :TAbon;
# Line 100  const Line 124  const
124    
125  implementation  implementation
126    
127  uses MojuUtils;  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                    //空行削除
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                    //代入
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;  constructor TAbon.Create;
238  begin  begin
239          // 初期化          // 初期化
240          FAbonString := '&nbsp;<>&nbsp;<>&nbsp;<>&nbsp;&nbsp;<><>';          FAbonString := '&nbsp;<>&nbsp;<>&nbsp;<>&nbsp;&nbsp;<><>';
241          FCreateNGwordFile := true;          FAbonRes := TIndiviAbonList.Create;
242          SetLength(FAbonRes,1);          FpAbons := PChar(FAbonString);
243          FAbonRes[0].Res := 0;          FpAbone := FpAbons + Length(FAbonString);
         FAbonRes[0].option := -1;  
244    
245  end;  end;
246    
247  destructor TAbon.Destroy;  destructor TAbon.Destroy;
248  begin  begin
249            FAbonRes.Free;
250          inherited;          inherited;
251  end;  end;
252  //rootはExe\config\NGwordsフォルダ  //rootはExe\config\NGwordsフォルダ
# Line 178  begin Line 310  begin
310          if path = '' then begin          if path = '' then begin
311                  Result := false;                  Result := false;
312          end else begin          end else begin
313    
314                  bufstl := TStringList.Create;                  bufstl := TStringList.Create;
315                  try                  try
316                          try                          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);                                  bufstl.LoadFromFile(path);
324                                  LoadFromStringList( bufstl );                                  LoadFromStringList( bufstl );
325                                  Result := true;                                  Result := true;
                         except  
                                 if CreateNGwordFile = true then begin  
                                         bufstl.SaveToFile(path);  
                                 end;  
                                 Result := false;  
326                          end;                          end;
327                  finally                  finally
328                          bufstl.Free;                          bufstl.Free;
# Line 242  var Line 376  var
376          pos : Integer;          pos : Integer;
377          buftoken : String;          buftoken : String;
378  begin  begin
         pos := 0;  
379          bufstl := TStringList.Create;          bufstl := TStringList.Create;
380          try          try
381                  if Length(argline) > 0 then begin                  if Length(argline) > 0 then begin
# Line 251  begin Line 384  begin
384                                  buftoken := Copy(argline,1,pos-1);                                  buftoken := Copy(argline,1,pos-1);
385                                  Delete(argline,1,pos);                                  Delete(argline,1,pos);
386                                  if Length(buftoken) > 0 then begin                                  if Length(buftoken) > 0 then begin
387                                          bufstl.Append(buftoken);                      // >> で始まるトークンはコメント扱いで無視する
388                        if AnsiPos('>>', buftoken) <> 1 then begin
389                                            bufstl.Append(buftoken);
390                        end;
391                                  end else if ( bufstl.Count = 0 ) then begin                                  end else if ( bufstl.Count = 0 ) then begin
392                                          bufstl.Append('');                                          bufstl.Append('');
393                                  end;                                  end;
394                                  pos := AnsiPos(#9,argline);                                  pos := AnsiPos(#9,argline);
395                          end;                          end;
396                          if Length(argline) > 0 then begin                          if Length(argline) > 0 then begin
397                                  bufstl.Append(argline);                  // >> で始まるトークンはコメント扱いで無視する
398                    if AnsiPos('>>', argline) <> 1 then begin
399                                    bufstl.Append(argline);
400                    end;
401                          end;                          end;
402                          ret := bufstl.Count;                          ret := bufstl.Count;
403                          SetLength(Ftokens[index],ret);                          SetLength(Ftokens[index],ret);
404                          for i := 0 to bufstl.Count - 1  do begin                          for i := 0 to bufstl.Count - 1  do begin
405                                  Ftokens[index][i] := bufstl.Strings[i];                                  if IgnoreKana then
406                                            Ftokens[index][i] := ZenToHan(bufstl.Strings[i])
407                                    else
408                        Ftokens[index][i] := bufstl.Strings[i];
409                          end;                          end;
410                  end;                  end;
411          finally          finally
# Line 297  var Line 439  var
439          hit : Boolean;          hit : Boolean;
440          bufline : String;          bufline : String;
441          start : Integer;          start : Integer;
442            target : String;
443            pos : PChar;
444            pts, pte : PChar;
445            trgLen : Integer;
446  begin  begin
447          hit := false;          hit := false;
448          if AnsiPos(FAbonString,line) <> 1 then begin          if AnsiStrPosEx(PChar(line), PChar(line)+Length(line), FpAbons, FpAbone) = nil then begin
449                  for lines := 0 to High(Ftokens) do begin                  //全半角ひらカナ無視するか
450                          hit := true;                  if IgnoreKana then
451                          bufline := line;                          target := ZenToHan(line)
452                          if Ftokens[lines][0] <> ''  then begin                  else
453                                  Invisible := false;                          target := line;
454                                  start := 0;  
455                          end else begin                  trgLen := Length(target);
                                 Invisible := true;  
                                 start := 1;  
                         end;  
456    
                         for cells := start to High(Ftokens[lines]) do begin  
                                 if AnsiPos(Ftokens[lines][cells],bufline) = 0 then begin  
                                         hit := false;  
                                         break;  
                                 end else begin  
                                         Delete(bufline,AnsiPos(Ftokens[lines][cells],bufline),Length(Ftokens[lines][cells]));  
                                 end;  
                         end;  
                         if hit = true then begin  
                                 NGwordsLineNum := lines + 1;  
                                 break;  
                         end;  
                 end;  
         end;  
         Result := hit;  
 end;  
 //NGワードが含まれていたらtrueを返し、そのNGワードの行数をNGwordsLineNumに入れて返す。  
 //もしも透明あぼ〜んにするならInbisibleをtrueにして返す  
 //半角全角無視  
 function TAbon.FindNGwordsEx(const line : String; var NGwordsLineNum : Integer; var Invisible : Boolean) : Boolean;//1ラインずつ用。  
 var  
         lines : Integer;  
         cells : Integer;  
         hit : Boolean;  
         bufline : String;  
         start : Integer;  
 begin  
         hit := false;  
         if AnsiPos(FAbonString,line) <> 1 then begin  
457                  for lines := 0 to High(Ftokens) do begin                  for lines := 0 to High(Ftokens) do begin
458                if Length(Ftokens[lines]) = 0 then begin
459                    Continue;
460                end;
461                          hit := true;                          hit := true;
462                          bufline := line;                          bufline := target;
463                            pts := PChar(bufline);
464                            pte := pts + trgLen;
465    
466                          if Ftokens[lines][0] <> ''  then begin                          if Ftokens[lines][0] <> ''  then begin
467                                  Invisible := false;                                  Invisible := false;
468                                  start := 0;                                  start := 0;
# Line 352  begin Line 472  begin
472                          end;                          end;
473    
474                          for cells := start to High(Ftokens[lines]) do begin                          for cells := start to High(Ftokens[lines]) do begin
475                                  if AnsiPos(Ftokens[lines][cells],bufline) = 0 then begin                                  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;                                          hit := false;
479                                          break;                                          break;
480                                  end else begin                                  end else begin
481                                          Delete(bufline, AnsiPos(Ftokens[lines][cells],bufline),Length(Ftokens[lines][cells]));                                          Delete(bufline, pos - pte + 1, Length(Ftokens[lines][cells]));
482                                            pts := PChar(bufline);
483                                            pte := pts + Length(bufline);
484                                  end;                                  end;
485                          end;                          end;
486                          if hit = true then begin                          if hit = true then begin
# Line 444  begin Line 568  begin
568          end;          end;
569  end;  end;
570    
 procedure TAbon.Execute(var ThreadStrings : TStringList; NGwords : TStringList);  
 var  
         i : Integer;  
 begin  
         SetLength(Ftokens,NGwords.Count);  
         for i := 0  to NGwords.Count -1 do begin  
                 SetTokens(i , NGwords.Strings[i]);  
         end;  
         Execute(ThreadStrings);  
   
 end;  
 procedure TAbon.Execute(var ThreadStrings : TStringList; NGwords : TStrings);  
 var  
         i : Integer;  
         buf : TStringList;  
 begin  
         buf := TStringList.Create;  
         buf.AddStrings(NGwords);  
         SetLength(Ftokens,buf.Count);  
         for i := 0  to buf.Count -1 do begin  
                 SetTokens(i , buf.Strings[i]);  
         end;  
         Execute(ThreadStrings);  
         buf.Free;  
 end;  
   
 //末尾のブール値はtrueだと、NGワードを含むものだけを返す。  
 procedure TAbon.ExecuteEx(var ThreadStrings : TStringList);  
 var  
         i : Integer;  
         NGwordsLine : Integer;  
         bufline : String;  
         invisi : Boolean;  
 begin  
         for i:=0 to ThreadStrings.Count - 1 do begin  
                 NGwordsLine := 0;  
                 if FindNGwordsEx(ThreadStrings.Strings[i], NGwordsLine ,invisi) <> Reverse  then begin  
                         if invisi = true then begin  
                                 ThreadStrings.Strings[i] := '';  
                         end else begin  
                                 if not ReturnNGwordLineNum and not SetNGResAnchor then begin  
                                         ThreadStrings.Strings[i] := FAbonString;  
                                 end else if not ReturnNGwordLineNum then begin  
                                         ThreadStrings.Strings[i] := Format('&nbsp;<>&nbsp;<>&nbsp;<>&gt;%d<><>',[(i+1)]);  
                                 end else if not SetNGResAnchor then begin  
                                         ThreadStrings.Strings[i] := Format('&nbsp;<>&nbsp;<>&nbsp;<><B> %d 行目のNGワードが含まれています。</B><><>',[NGwordsLine]);  
                                 end else begin  
                                         ThreadStrings.Strings[i] := Format('&nbsp;<>&nbsp;<>&nbsp;<><B> %d 行目のNGワードが含まれています。</B>&gt;%d <><>',[NGwordsLine,(i+1)]);  
                                 end;  
                         end;  
                 end else begin  
                         bufline := ThreadStrings.Strings[i];  
                         if Deleterlo = true then begin  
                                 bufline := CustomStringReplace(bufline,'&rlo;','');  
                                 bufline := CustomStringReplace(bufline,'&lro;','');  
                         end;  
                         if Replaceul = true then begin  
                                 bufline := CustomStringReplace( bufline,'<ul>','<br>' );  
                                 bufline := CustomStringReplace( bufline,'</ul>','<br>' );  
                         end;  
                         if DeleteSyria = true then  
                                 bufline := TreatSyria(bufline);  
                         ThreadStrings.Strings[i] := bufline;  
                 end;  
         end;  
 end;  
 procedure TAbon.ExecuteEx(var ResString : String; ResNumber : Integer);  
 var  
         NGwordsLine : Integer;  
         bufline : String;  
         invisi : Boolean;  
 begin  
         NGwordsLine := 0;  
         if FindNGwordsEx(ResString, NGwordsLine ,invisi) <> Reverse  then begin  
                 if invisi = true then begin  
                         ResString := '';  
                 end else begin  
                         if not ReturnNGwordLineNum and not SetNGResAnchor then begin  
                                 ResString := FAbonString;  
                         end else if not ReturnNGwordLineNum then begin  
                                 ResString := Format('&nbsp;<>&nbsp;<>&nbsp;<>&gt;%d<><>',[(ResNumber)]);  
                         end else if not SetNGResAnchor then begin  
                                 ResString := Format('&nbsp;<>&nbsp;<>&nbsp;<><B> %d 行目のNGワードが含まれています。</B><><>',[NGwordsLine]);  
                         end else begin  
                                 ResString := Format('&nbsp;<>&nbsp;<>&nbsp;<><B> %d 行目のNGワードが含まれています。</B>&gt;%d <><>',[NGwordsLine,(ResNumber)]);  
                         end;  
                 end;  
         end else begin  
                 bufline := ResString;  
                 if Deleterlo = true then begin  
                         bufline := CustomStringReplace( bufline,'&rlo;','' );  
                         bufline := CustomStringReplace( bufline,'&lro;','' );  
                 end;  
                 if Replaceul = true then begin  
                         bufline := CustomStringReplace( bufline,'<ul>','<br>' );  
                         bufline := CustomStringReplace( bufline,'</ul>','<br>' );  
                 end;  
                 if DeleteSyria = true then  
                         bufline := TreatSyria(bufline);  
                 ResString := bufline;  
         end;  
 end;  
   
 procedure TAbon.ExecuteEx(var ThreadStrings : TStringList; NGwords : TStringList);  
 var  
         i : Integer;  
 begin  
         SetLength(Ftokens,NGwords.Count);  
         for i := 0  to NGwords.Count -1 do begin  
                 SetTokens(i , NGwords.Strings[i]);  
         end;  
         ExecuteEx(ThreadStrings);  
571    
 end;  
 procedure TAbon.ExecuteEx(var ThreadStrings : TStringList; NGwords : TStrings);  
 var  
         i : Integer;  
         buf : TStringList;  
 begin  
         buf := TStringList.Create;  
         buf.AddStrings(NGwords);  
         SetLength(Ftokens,buf.Count);  
         for i := 0  to buf.Count -1 do begin  
                 SetTokens(i , buf.Strings[i]);  
         end;  
         ExecuteEx(ThreadStrings);  
         buf.Free;  
 end;  
572    
573  //****************************************************************************//  //****************************************************************************//
574  //現在セットされているNGword.txtを開く  //現在セットされているNGword.txtを開く
# Line 651  begin Line 648  begin
648      end;      end;
649    
650  end;  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                            // 初めての学習かつ個別あぼ〜んありなので、旧verからの移行につき
669                            // 個別あぼ〜んを使った学習
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                            // 旧verからの移行ではないのでレスを全て推論で学習
694                            // ※推論が間違っている場合はユーザがあぼ〜んを修正する事で学習される
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  //複数のNGワードテキストを読み込む=====ここまで=================================  //複数のNGワードテキストを読み込む=====ここまで=================================
725  //個別あぼ〜ん実行関数  //個別あぼ〜ん実行関数
726  procedure TAbon.IndividualAbon(var ThreadStrings : TStringList; SetResNumFile : String);  procedure TAbon.IndividualAbon(var ThreadStrings : TStringList; SetResNumFile : String);
727  var  var
728          i : Integer;          i : Integer;
729            f : Boolean;
730  begin  begin
731          if FileExists(SetResNumFile) = true then begin          f := LoadFromSetResNumFile( SetResNumFile );
732          if LoadFromSetResNumFile(SetResNumFile) = true then begin          FAbonRes.FFilePath := SetResNumFile;    // Learn はで保存するので
733                  for i := 0 to High(FAbonRes) do begin  {$IFDEF SPAM_FILTER_ENABLED}
734                   if (FAbonRes[i].Res <= ThreadStrings.Count) and (FAbonRes[i].Res > 0) then begin          Learn( ThreadStrings );
735                          if FAbonRes[i].option = 0 then begin  {$ENDIF}
736                          ThreadStrings.Strings[FAbonRes[i].Res-1] := '';  
737                      end else begin          if f then begin
738                          ThreadStrings.Strings[FAbonRes[i].Res-1] := 'あぼ〜ん<>あぼ〜ん<>あぼ〜ん<>あぼ〜ん<>';                  for i := 0 to FAbonRes.Count - 1 do begin
739                      end;                          if (FAbonRes[i].Res <= ThreadStrings.Count) and (FAbonRes[i].Res > 0) then begin
740                   end;  {$IFDEF NO_ABON}
741                                    ThreadStrings.Strings[FAbonRes[i].Res-1] :=
742              end;                                          '<font color="red">あぼ〜ん済み</font>' +
743          end;                                          ThreadStrings.Strings[FAbonRes[i].Res-1];
744      end else begin  {$ELSE}
745          FIndividualFileName := SetResNumFile;                                  if FAbonRes[i].option = 0 then begin
746          SetLength(FAbonRes,1);                                          ThreadStrings.Strings[FAbonRes[i].Res-1] := '';
747          FAbonRes[0].Res := 0;                                  end else begin
748          FAbonRes[0].option := -1;                                          ThreadStrings.Strings[FAbonRes[i].Res-1] := 'あぼ〜ん<>あぼ〜ん<>あぼ〜ん<>あぼ〜ん<>';
749      end;                                  end;
750    {$ENDIF}
751                            end;
752                    end;
753            end;
754  end;  end;
755  procedure TAbon.IndividualAbon(var ResString : String; SetResNumFile : String; ResNumber : Integer);  procedure TAbon.IndividualAbon(var ResString : String; SetResNumFile : String; ResNumber : Integer);
756  var  var
# Line 683  var Line 758  var
758  begin  begin
759          if FileExists(SetResNumFile) = true then begin          if FileExists(SetResNumFile) = true then begin
760          if LoadFromSetResNumFile(SetResNumFile) = true then begin          if LoadFromSetResNumFile(SetResNumFile) = true then begin
761                  for i := 0 to High(FAbonRes) do begin                                          for i := 0 to FAbonRes.Count - 1 do begin
762                   if FAbonRes[i].Res = ResNumber then begin                   if FAbonRes[i].Res = ResNumber then begin
763                          if FAbonRes[i].option = 0 then begin                          if FAbonRes[i].option = 0 then begin
764                          ResString := '';                          ResString := '';
# Line 695  begin Line 770  begin
770              end;              end;
771          end;          end;
772      end else begin      end else begin
773          FIndividualFileName := SetResNumFile;                                  FIndividualFileName := SetResNumFile;
774          SetLength(FAbonRes,1);                                  FAbonRes.Free;
775          FAbonRes[0].Res := 0;                                  FAbonRes := TIndiviAbonList.Create;
776          FAbonRes[0].option := -1;                  end;
     end;  
777  end;  end;
778    
779  //個別あぼ〜んファイル読み込み関数  //個別あぼ〜んファイル読み込み関数
780  function TAbon.LoadFromSetResNumFile(SetResNumFile : String) : Boolean;  function TAbon.LoadFromSetResNumFile(SetResNumFile : String) : Boolean;
 var  
         bufStringList : TStringList;  
     bufLine : String;  
     i : Integer;  
781  begin  begin
782      bufStringList := TStringList.Create;  
783      try          FIndividualFileName := SetResNumFile;
784          try          FAbonRes.Free;
785                  bufStringList.LoadFromFile(SetResNumFile);          FAbonRes := TIndiviAbonList.Create;
786              FIndividualFileName := SetResNumFile;          if FileExists( SetResNumFile ) then begin
787              //空行削除                  FAbonRes.LoadFromFile( SetResNumFile );
788              for i := bufStringList.Count-1 downto 0 do begin                  Result := true;
789                          if bufStringList.Strings[i] = '' then begin          end else begin
790                          bufStringList.Delete(i);                  Result := False;
791                      end;          end;
792              end;  
   
             //メモリ確保  
                 SetLength(FAbonRes,bufStringList.Count);  
             //代入  
             for i :=0 to bufStringList.Count - 1 do begin  
                         bufLine := Trim(bufStringList.Strings[i]);  
                     FAbonRes[i].Res :=  StrToInt(Copy(bufLine,1,AnsiPos('-',bufLine)-1));  
                 FAbonRes[i].option := StrToInt(Copy(bufLine,AnsiPos('-',bufLine)+1,1));  
             end;  
         except  
                 Result := false;  
             Exit;  
         end;  
     finally  
         bufStringList.Free;  
     end;  
     Result := true;  
793  end;  end;
794  //個別あぼ〜んファイルに追加  //個別あぼ〜んファイルに追加
795  procedure TAbon.AddIndividualAbon( ResNum : Integer ; option : Integer);  procedure TAbon.AddIndividualAbon( ResNum : Integer ; option : Integer; SetResNumFile : String);
796  var  var
797          IndividualFile : TStringList;          IndividualFile : TStringList;
798      linebuf : String;          i, j : Integer;
     i : Integer;  
799  begin  begin
800      IndividualFile := TStringList.Create;          IndividualFile := TStringList.Create;
801          if FAbonRes[0].Res <> 0 then begin          try
802          for i := 0 to High(FAbonRes) do begin                  if FileExists(SetResNumFile) then begin
803              if FAbonRes[i].Res <> ResNum then begin                          IndividualFile.LoadFromFile(SetResNumFile);
804                          linebuf := IntToStr(FAbonRes[i].Res) + '-' + IntToStr(FabonRes[i].option);                          i := -1;
805                  IndividualFile.Append(linebuf);                          for j := 0 to IndividualFile.Count -1 do begin
806              end;                                  if AnsiPos(IntToStr(ResNum) + '-', IndividualFile[j]) = 1 then begin
807          end;                                          i := j;
808      end;                                          break;
809      linebuf := IntToStr(ResNum) + '-' + IntToStr(option);                                  end;
810      IndividualFile.Append(linebuf);                          end;
811      try                          if i = -1 then
812          IndividualFile.SaveToFile(FIndividualFileName);                                  IndividualFile.Add(IntToStr(ResNum) + '-' + IntToStr(option))
813      finally                          else
814          IndividualFile.Free;                                  IndividualFile[j] := IntToStr(ResNum) + '-' + IntToStr(option);
815      end;  
816  end;                  end else begin
817  //個別あぼ〜んファイルから削除                          IndividualFile.Add(IntToStr(ResNum) + '-' + IntToStr(option));
818  procedure TAbon.DeleteIndividualAbon( ResNum : Integer);                  end;
819  var                  IndividualFile.SaveToFile(SetResNumFile);
820          IndividualFile : TStringList;          finally
821      linebuf : String;                  IndividualFile.Free;
822      i : Integer;          end;
 begin  
     IndividualFile := TStringList.Create;  
         if FAbonRes[0].Res <> 0 then begin  
         for i := 0 to High(FAbonRes) do begin  
             if FAbonRes[i].Res <> ResNum then begin  
                         linebuf := IntToStr(FAbonRes[i].Res) + '-' + IntToStr(FabonRes[i].option);  
                 IndividualFile.Append(linebuf);  
             end;  
         end;  
     end;  
         if IndividualFile.Count <> 0 then begin  
         try  
                 IndividualFile.SaveToFile(FIndividualFileName);  
         finally  
                 IndividualFile.Free;  
         end;  
     end else begin  
         if FileExists(FIndividualFileName) = true then begin  
                 DeleteFile(FIndividualFileName);  
         end;  
     end;  
 end;  
 //個別あぼ〜んのリストの個数を返す  
 function TAbon.GetAbonResCount() : Integer;  
 var  
         i : Integer;  
 begin  
     if FAbonRes[0].Res = 0 then begin  
         Result := 0  
     end else begin  
                 i := High(FAbonRes);  
         Result := i+1;  
     end;  
 end;  
 //個別あぼ〜んのリストのn行目のレスを文字列で返す  
 function TAbon.GetAbonResString(Num : Integer) : String;  
 begin  
         if (Num <= High(FAbonRes)) and (Num >= 0) then begin  
         Result := IntToStr(FAbonRes[Num].Res);  
     end else begin  
         Result := '';  
     end;  
823  end;  end;
824    
825  //ポップアップの判定用  //ポップアップの判定用
826  function TAbon.CheckIndividualAbonList(ResNum : Integer) : Boolean;  function TAbon.CheckIndividualAbonList(ResNum : Integer) : Boolean;
827  var  var
828          i : Integer;          i : Integer;
829  begin  begin
830          if FAbonRes[0].Res <> 0 then begin          if (FAbonRes.Count > 0) and (FAbonRes[0].Res <> 0) then begin
831          for i := 0 to High(FAbonRes) do begin                  for i := 0 to FAbonRes.Count - 1 do begin
832                  if FAbonRes[i].Res = ResNum then begin                          if FAbonRes[i].Res = ResNum then begin
833                  Result := true;                                  Result := true;
834                  Exit;                                  Exit;
835              end;                          end;
836          end;                  end;
837      end;          end;
838          Result := false;          Result := false;
839    
840  end;  end;
841  //シリア語ブラクラ対策  //シリア語ブラクラ対策
842  function TAbon.TreatSyria(AString: string): string;  function TAbon.TreatSyria(AString: string): string;
843    const
844            UNI_TAG = '&#';
845  var  var
846          //count: Integer; //(&#1792~&#1871)          //count: Integer; //(&#1792~&#1871)
847          pos: Integer;          ps : PChar;
848          tmp: string;          p, pe, s, se : PChar;
849  begin          scode: String;
850          pos := AnsiPos('&#18', AString);          icode: Integer;
851          while pos <> 0  do begin  begin
852                  if StrToIntDef(Copy(AString, pos+4, 2), -1) > 0 then begin  
853                          if (AString[pos+6] = ';' )  or (AString[pos+6] = ' ') then begin          Result := '';
854                                  tmp := tmp + Copy(AString, 1, pos - 1);  
855                                  Delete(AString, 1, pos+6);          p := PChar(AString);
856                          end else if StrToIntDef(AString[pos+6], -1) = -1 then begin          pe := p + Length(AString);
857                                  tmp := tmp + Copy(AString, 1, pos - 1);          s := PChar(UNI_TAG);
858                                  Delete(AString, 1, pos+5);          se := s + Length(UNI_TAG);
859                          end else begin  
860                                  tmp := tmp + Copy(AString, 1, pos + 5);          p := AnsiStrPosEx(p, pe, s, se);
861                                  Delete(AString, 1, pos+5);  
862                          end;          while p <> nil do begin
863                  end else begin                  //&#の手前までコピーする
864                          tmp := tmp + Copy(AString, 1, pos + 5);                  Result := Result + Copy(AString, 1, p - PChar(AString));
865                          Delete(AString, 1, pos+5);                  //&#の手前まで削除する
866                  end;                  Delete(AString, 1, p - PChar(AString));
867                  pos := AnsiPos('&#18', AString);  
868          end;                  //AStringに3文字以上あれば次の3文字目をチェック
869          if Length(AString) > 0 then                  if Length(AString) > 2 then begin
870                  tmp := tmp + AString;                          ps := PChar(AString) + 2;
871          AString := tmp;                          if (ps^ = 'x') or (ps^ = 'X') then begin
872          tmp := '';                                  //16進表記
873                                    Inc(ps);
874          pos := AnsiPos('&#179', AString);                                  scode := '0x';
875          while pos <> 0 do begin                                  while ((ps^ >= '0') and (ps^ <= '9')) or
876                  if StrToIntDef(Copy(AString, pos+5, 1), 0) > 2 then begin                                          ((ps^ >= 'a') and (ps^ <= 'f')) or
877                          if (AString[pos+6] = ';') or (AString[pos+6] = ' ') then begin                                          ((ps^ >= 'A') and (ps^ <= 'F')) do begin
878                                  tmp := tmp + Copy(AString, 1, pos - 1);                                          
879                                  Delete(AString, 1, pos+6);                                          scode := scode + String(ps^);
880                          end else if StrToIntDef(AString[pos+6], -1) = -1 then begin                                          Inc(ps);
881                                  tmp := tmp + Copy(AString, 1, pos - 1);                                  end;
                                 Delete(AString, 1, pos+5);  
882                          end else begin                          end else begin
883                                  tmp := tmp + Copy(AString, 1, pos + 5);                                  //10進表記
884                                  Delete(AString, 1, pos+5);                                  scode := '';
885                                    while ((ps^ >= '0') and (ps^ <= '9')) do begin
886                                            scode := scode + String(ps^);
887                                            Inc(ps);
888                                    end;
889                          end;                          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                  end else begin
905                          tmp := tmp + Copy(AString, 1, pos + 5);              //後ろに文字が無いので、そのままResultに突っ込む
906                          Delete(AString, 1, pos+5);                          Result := Result + AString;
907                            AString := '';
908                  end;                  end;
909                  pos := AnsiPos('&#179', AString);                  p := PChar(AString);
910                    pe := p + Length(AString);
911                    p := AnsiStrPosEx(p, pe, s, se);
912          end;          end;
913          if Length(AString) > 0 then  
914                  tmp := tmp + AString;      //残った文字列を足して結果にする
915          Result := tmp;          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;  end;
944    
945    
946  end.  end.
947    

Legend:
Removed from v.1.17.2.3  
changed lines
  Added in v.1.46

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