AbonUnit.pas

   1 {
   2 NO_ABON                                                 \82 \82Ú\81[\82ñ\8dÏ\82Ý\82Ì\83\8c\83X\82à\95\\8e¦\82·\82é(\8b\92²\82³\82ê\82é)
   3 SPAM_FILTER_ENABLED     \83X\83p\83\80\83t\83B\83\8b\83^\82ð\8b@\94\\82³\82¹\82é
   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:\93§\96¾ 1:\92Ê\8fí\82 \82Ú\81[\82ñ
  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;               //!< \83t\83@\83C\83\8b\83p\83X
  25                 FLearned        : Integer;      //!< \83X\83p\83\80\8aw\8fK\8dÏ\82Ý\83\8c\83X 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 \90é\8c¾ }
  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;\82ð\8dí\82é\82© //\92Ç\89Á&lro;\82à\8dí\82é
  52         FReplaceul :Boolean ; //<ul>\83^\83O\82ð<br>\83^\83O\82É\92u\8a·\82·\82é\82©
  53         FReverse : Boolean ;  //NG\83\8f\81[\83h\82Å\82Ì\82 \82Ú\81`\82ñ\82Ì\8c\8b\89Ê\82ð\94½\93]\82³\82¹\82é\82©
  54         FAbonPopupRes : Boolean; //\83\8c\83X\83|\83b\83v\83A\83b\83v\82Ì\8e\9e\82É\82 \82Ú\81[\82ñ\82·\82é\82©
  55         FNGwordFileIndex : Integer; //\8c»\8dÝ\93Ç\82Ý\8d\9e\82ñ\82Å\82éNG\83\8f\81[\83h\82ªlist\82Ì\89½\8ds\96Ú\82©
  56         FNGwordname : String; //\8c»\8dÝ\93Ç\82Ý\8d\9e\82ñ\82Å\82éNG\83\8f\81[\83h\82Ì\95\\8e¦\96¼
  57         FIndividualFileName : String;   //\8cÂ\95Ê\82 \82Ú\81`\82ñ\82Ì\83t\83@\83C\83\8b\96¼
  58         FReturnNGwordLineNum : Boolean; //NG\83\8f\81[\83h\82Ì\8ds\90\94\82ð\95Ô\82·\81B
  59         FSetNGResAnchor : Boolean; //NG\82É\8aY\93\96\82µ\82½\82Æ\82«\82É\96{\95¶\82É\82»\82Ì\83\8c\83X\82Ö\82Ì\83\8c\83X\83A\83\93\83J\81[\82ð\82Â\82¯\82é\82©\82Ç\82¤\82©
  60         FDeleteSyria: Boolean;  //\83V\83\8a\83A\8cê\83u\83\89\83N\83\89\91Î\8dô\81i&#1792~&#1871\81j
  61         FIgnoreKana: Boolean;   //\91S\8ap\94¼\8ap\82Ð\82ç\82ª\82È\83J\83^\83J\83i\82Ì\88á\82¢\82ð\96³\8e\8b\82·\82é\82©
  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 \90é\8c¾ }
  70         constructor Create; // \83R\83\93\83X\83g\83\89\83N\83^
  71         destructor Destroy; override; // \83f\83X\83g\83\89\83N\83^
  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\83\89\83C\83\93\82¸\82Â\97p\81B
  95         //\82 \82Ú\81`\82ñ\8f\88\97\9d(NG\83\8f\81[\83h\82Å\82Ì\83t\83B\83\8b\83^\83\8a\83\93\83O)
  96         procedure Execute(var ThreadStrings : TStringList); overload;
  97         procedure Execute(var ResString : String; ResNumber : Integer); overload;       //\8eå\82Éplugin\82©\82ç\82ÌDat To HTML \97p
  98
  99 {$IFDEF SPAM_FILTER_ENABLED}
 100         //! \83X\83p\83\80\83t\83B\83\8b\83^\82Ì\8aw\8fK
 101         procedure Learn( resList : TStringList );
 102 {$ENDIF}
 103         //\8cÂ\95Ê\82 \82Ú\81`\82ñ\82µ\82å\82è
 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\82ð\8aJ\82\81B
 110         function ShowAllTokens() : String;  //\83f\83o\83b\83O\97p
 111         //--
 112         procedure GoHome();//List\82Ì\82P\8ds\96Ú\82ð\93Ç\82Þ
 113         function GoForward() : Boolean; //List\82Ì\88ê\82Â\8e\9f\82ÌNG\83\8f\81[\83h\83t\83@\83C\83\8b\82ð\93Ç\82Ý\8d\9e\82Þ
 114         function GoBack() : Boolean; //List\82Ì\88ê\82Â\91O\82ÌNG\83\8f\81[\83h\83t\83@\83C\83\8b\82ð\93Ç\82Ý\8d\9e\82Þ
 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                 //\8bó\8ds\8dí\8f\9c
 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                 //\91ã\93ü
 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         // \8f\89\8aú\89»
 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\82ÍExe\config\NGwords\83t\83H\83\8b\83_
 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\82ÍNGword.txt\82Ì\83t\83\8b\83p\83X
 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 //\83t\83\8b\83p\83X\82Å\82È\82¯\82ê\82Î\83t\83\8b\83p\83X\82É\82µ\82Ä\95Ô\82·\81B
 287 function TAbon.Getfullpath(argpath : String) : String;
 288 begin
 289         if AnsiPos(':\',argpath) <> 2 then begin  //\83h\83\89\83C\83u\82©\82ç\82Ì\83t\83\8b\83p\83X\82ª\96³\82¯\82ê\82Î
 290                 if Getroot() = '' then begin
 291                         Result := '';    //root\83p\83X\82ª\90Ý\92è\82³\82ê\82Ä\82È\82¢\82©\8bó\82É\82·\82é
 292                 end else begin
 293                         if (Froot[Length(Froot)] = '\') and (argpath[1] = '\') then begin  //\90æ\93ª\82Ì\\82ð\8dí\8f\9c
 294                                 Delete(argpath,1,1);
 295                         end;
 296                         Insert( Getroot(), argpath , 1);//root\83p\83X\82ð\91}\93ü
 297                         Result := argpath;
 298                 end;
 299         end else begin
 300                 Result := argpath;
 301         end;
 302
 303 end;
 304 //NGword\83t\83@\83C\83\8b\82Ì\93Ç\82Ý\8d\9e\82Ý
 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\83\8a\83X\83g\93Ç\82Ý\8d\9e\82Ý
 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\82ª\8aù\82É\90Ý\92è\82³\82ê\82Ä\82¢\82é\82Æ\82«\82Ì\83\8a\83\8d\81[\83h\97p\8aÖ\90\94
 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 //\88ê\8ds\82Ì\92\86\82Ì\83g\81[\83N\83\93\82ð\90Ø\82è\95ª\82¯\82Ä\83Z\83b\83g
 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                     // >> \82Å\8en\82Ü\82é\83g\81[\83N\83\93\82Í\83R\83\81\83\93\83g\88µ\82¢\82Å\96³\8e\8b\82·\82é
 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                 // >> \82Å\8en\82Ü\82é\83g\81[\83N\83\93\82Í\83R\83\81\83\93\83g\88µ\82¢\82Å\96³\8e\8b\82·\82é
 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\97p\82¿\82á\82ñ\82ÆNG\83\8f\81[\83h\82ð\8fE\82¦\82Ä\82¢\82é\82©
 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\83\8f\81[\83h\82ª\8aÜ\82Ü\82ê\82Ä\82¢\82½\82çtrue\82ð\95Ô\82µ\81A\82»\82ÌNG\83\8f\81[\83h\82Ì\8ds\90\94\82ðNGwordsLineNum\82É\93ü\82ê\82Ä\95Ô\82·\81B
 434 //\82à\82µ\82à\93§\96¾\82 \82Ú\81`\82ñ\82É\82·\82é\82È\82çInbisible\82ðtrue\82É\82µ\82Ä\95Ô\82·
 435 function TAbon.FindNGwords(const line : String; var NGwordsLineNum : Integer; var Invisible : Boolean) : Boolean; //1\83\89\83C\83\93\82¸\82Â\97p\81B
 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                 //\91S\94¼\8ap\82Ð\82ç\83J\83i\96³\8e\8b\82·\82é\82©
 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 //\96\96\94ö\82Ì\83u\81[\83\8b\92l\82Ítrue\82¾\82Æ\81ANG\83\8f\81[\83h\82ð\8aÜ\82Þ\82à\82Ì\82¾\82¯\82ð\95Ô\82·\81B
 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 \8ds\96Ú\82ÌNG\83\8f\81[\83h\82ª\8aÜ\82Ü\82ê\82Ä\82¢\82Ü\82·\81B</B><><>',[NGwordsLine]);
 514                                 end else begin
 515                                         ThreadStrings.Strings[i] := Format('&nbsp;<>&nbsp;<>&nbsp;<><B> %d \8ds\96Ú\82ÌNG\83\8f\81[\83h\82ª\8aÜ\82Ü\82ê\82Ä\82¢\82Ü\82·\81B</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 \8ds\96Ú\82ÌNG\83\8f\81[\83h\82ª\8aÜ\82Ü\82ê\82Ä\82¢\82Ü\82·\81B</B><><>',[NGwordsLine]);
 551                         end else begin
 552                                 ResString := Format('&nbsp;<>&nbsp;<>&nbsp;<><B> %d \8ds\96Ú\82ÌNG\83\8f\81[\83h\82ª\8aÜ\82Ü\82ê\82Ä\82¢\82Ü\82·\81B</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 //\8c»\8dÝ\83Z\83b\83g\82³\82ê\82Ä\82¢\82éNGword.txt\82ð\8aJ\82
 575 procedure TAbon.EditNGwords();
 576 begin
 577         ShellExecute(0 ,nil,PChar(FNGwordpath),nil,nil,SW_SHOW);
 578 end;
 579 //\83|\83b\83v\83A\83b\83v\97p\94»\92è\8aÖ\90\94
 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 //\95¡\90\94\82ÌNG\83\8f\81[\83h\83e\83L\83X\83g\82ð\93Ç\82Ý\8d\9e\82Þ==============================================
 592 //List\83t\83@\83C\83\8b\82ð\93Ç\82Ý\8d\9e\82Þ
 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('\88ê\94Ê=NGword.txt');
 600         listStringList.SaveToFile(path);
 601         Result := false;
 602     end;
 603 end;
 604 //List\82Ì\88ê\82Â\8e\9f\82ÌNG\83\8f\81[\83h\83t\83@\83C\83\8b\82ð\93Ç\82Ý\8d\9e\82Þ
 605 function TAbon.GoForward() : Boolean;
 606 begin
 607     FNGwordFileIndex := FNGwordFileIndex + 1;
 608     Result := ReadNGwordslist(FNGwordFileIndex);
 609 end;
 610 //List\82Ì\88ê\82Â\91O\82ÌNG\83\8f\81[\83h\83t\83@\83C\83\8b\82ð\93Ç\82Ý\8d\9e\82Þ
 611 function TAbon.GoBack() : Boolean;
 612 begin
 613     FNGwordFileIndex := FNGwordFileIndex -1;
 614     Result := ReadNGwordslist(FNGwordFileIndex);
 615 end;
 616 //List\82Ì\82P\8ds\96Ú\82ð\93Ç\82Þ
 617 procedure TAbon.GoHome();
 618 begin
 619     FNGwordFileIndex := 0;
 620     ReadNGwordslist(FNGwordFileIndex);
 621 end;
 622 //List\82Ìline\8ds\96Ú\82ð\93Ç\82Þ
 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                         // \8f\89\82ß\82Ä\82Ì\8aw\8fK\82©\82Â\8cÂ\95Ê\82 \82Ú\81`\82ñ\82 \82è\82È\82Ì\82Å\81A\8b\8cver\82©\82ç\82Ì\88Ú\8ds\82É\82Â\82«
 669                         // \8cÂ\95Ê\82 \82Ú\81`\82ñ\82ð\8eg\82Á\82½\8aw\8fK
 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                         // \8b\8cver\82©\82ç\82Ì\88Ú\8ds\82Å\82Í\82È\82¢\82Ì\82Å\83\8c\83X\82ð\91S\82Ä\90\84\98_\82Å\8aw\8fK
 694                         // \81¦\90\84\98_\82ª\8aÔ\88á\82Á\82Ä\82¢\82é\8fê\8d\87\82Í\83\86\81[\83U\82ª\82 \82Ú\81`\82ñ\82ð\8fC\90³\82·\82é\8e\96\82Å\8aw\8fK\82³\82ê\82é
 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                                         // \83X\83p\83\80
 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                                         // \83n\83\80
 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 //\95¡\90\94\82ÌNG\83\8f\81[\83h\83e\83L\83X\83g\82ð\93Ç\82Ý\8d\9e\82Þ=====\82±\82±\82Ü\82Å=================================
 725 //\8cÂ\95Ê\82 \82Ú\81`\82ñ\8eÀ\8ds\8aÖ\90\94
 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 \82Í\82Å\95Û\91¶\82·\82é\82Ì\82Å
 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">\82 \82Ú\81`\82ñ\8dÏ\82Ý</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] := '\82 \82Ú\81`\82ñ<>\82 \82Ú\81`\82ñ<>\82 \82Ú\81`\82ñ<>\82 \82Ú\81`\82ñ<>';
 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 := '\82 \82Ú\81`\82ñ<>\82 \82Ú\81`\82ñ<>\82 \82Ú\81`\82ñ<>\82 \82Ú\81`\82ñ<>';
 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 //\8cÂ\95Ê\82 \82Ú\81`\82ñ\83t\83@\83C\83\8b\93Ç\82Ý\8d\9e\82Ý\8aÖ\90\94
 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 //\8cÂ\95Ê\82 \82Ú\81`\82ñ\83t\83@\83C\83\8b\82É\92Ç\89Á
 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 //\83|\83b\83v\83A\83b\83v\82Ì\94»\92è\97p
 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 //\83V\83\8a\83A\8cê\83u\83\89\83N\83\89\91Î\8dô
 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                 //&#\82Ì\8eè\91O\82Ü\82Å\83R\83s\81[\82·\82é
 864                 Result := Result + Copy(AString, 1, p - PChar(AString));
 865                 //&#\82Ì\8eè\91O\82Ü\82Å\8dí\8f\9c\82·\82é
 866                 Delete(AString, 1, p - PChar(AString));
 867
 868                 //AString\82É3\95¶\8e\9a\88È\8fã\82 \82ê\82Î\8e\9f\82Ì3\95¶\8e\9a\96Ú\82ð\83`\83F\83b\83N
 869                 if Length(AString) > 2 then begin
 870                         ps := PChar(AString) + 2;
 871                         if (ps^ = 'x') or (ps^ = 'X') then begin
 872                                 //16\90i\95\\8bL
 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\90i\95\\8bL
 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                         //\8dÅ\8cã\82ª;\82Å\95Â\82¶\82Ä\82¢\82È\82¯\82ê\82Î\81A\88ê\95¶\8e\9a\91O\82Ü\82Å\82É\82·\82é
 893                         if not (ps^ = ';') then
 894                                 Dec(ps);
 895
 896                         //\83V\83\8a\83A\8cê\83u\83\89\83N\83\89\82Ì\82Å\82È\82¢
 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             //\8cã\82ë\82É\95¶\8e\9a\82ª\96³\82¢\82Ì\82Å\81A\82»\82Ì\82Ü\82ÜResult\82É\93Ë\82Á\8d\9e\82Þ
 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     //\8ec\82Á\82½\95¶\8e\9a\97ñ\82ð\91«\82µ\82Ä\8c\8b\89Ê\82É\82·\82é
 915         Result := Result + AString;
 916 end;
 917
 918 // NG\83\8f\81[\83h\83t\83@\83C\83\8b\82É\92Ç\89Á \92Ç\89Á\82³\82ê\82½\8fê\8d\87\81ATrue\82ª\82©\82¦\82é
 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