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   end;
 118 var
 119         Abon1 :TAbon;
 120 const
 121         NGwordListFileName : String = 'NGwords.list';
 122
 123 implementation
 124
 125 uses MojuUtils, GikoSystem, GikoBayesian, Setting;
 126
 127 function InvidiAbonListSort( item1, item2 : Pointer ) : Integer;
 128 begin
 129
 130         Result := TIndiviAbon( item1 ).Res - TIndiviAbon( item2 ).Res;
 131
 132 end;
 133
 134 destructor TIndiviAbonList.Destroy;
 135 var
 136         i : Integer;
 137 begin
 138
 139         for i := 0 to Count - 1 do
 140                 if inherited Items[ i ] <> nil then
 141                         TObject( inherited Items[ i ] ).Free;
 142
 143         inherited;
 144
 145 end;
 146
 147 function TIndiviAbonList.GetItem( index : Integer ) : TIndiviAbon;
 148 begin
 149
 150         Result := TIndiviAbon( inherited Items[ index ] );
 151
 152 end;
 153
 154 procedure TIndiviAbonList.SetItem( index : Integer; value : TIndiviAbon );
 155 begin
 156
 157         inherited Items[ index ] := Pointer( value );
 158
 159 end;
 160
 161 procedure TIndiviAbonList.Sort;
 162 begin
 163
 164         inherited Sort( InvidiAbonListSort );
 165
 166 end;
 167
 168 procedure TIndiviAbonList.LoadFromFile( const filePath : string );
 169 var
 170         bufStringList   : TStringList;
 171         bufLine                         : string;
 172         i                                                       : Integer;
 173         item                                    : TIndiviAbon;
 174 begin
 175
 176         if not FileExists( filePath ) then begin
 177                 FLearned := 0;
 178                 Exit;
 179         end;
 180
 181         FFilePath := filePath;
 182         bufStringList := TStringList.Create;
 183         try
 184                 bufStringList.LoadFromFile( filePath );
 185                 if bufStringList.Values[ 'Learned' ] <> '' then begin
 186                         FLearned := StrToInt( bufStringList.Values[ 'Learned' ] );
 187                         bufStringList.Delete( bufStringList.IndexOfName( 'Learned' ) );
 188                 end else begin
 189                         FLearned := 0;
 190                 end;
 191
 192                 //\8bó\8ds\8dí\8f\9c
 193                 for i := bufStringList.Count-1 downto 0 do begin
 194                         if bufStringList.Strings[i] = '' then begin
 195                                 bufStringList.Delete(i);
 196                         end;
 197                 end;
 198
 199                 //\91ã\93ü
 200                 for i := 0 to bufStringList.Count - 1 do begin
 201                         bufLine                 := Trim(bufStringList.Strings[i]);
 202                         item                            := TIndiviAbon.Create;
 203                         item.Res                := StrToInt(Copy(bufLine,1,AnsiPos('-',bufLine)-1));
 204                         item.option     := StrToInt(Copy(bufLine,AnsiPos('-',bufLine)+1,1));
 205                         Add( item );
 206                 end;
 207         finally
 208                 bufStringList.Free;
 209         end;
 210
 211 end;
 212
 213 procedure TIndiviAbonList.Save;
 214 var
 215         bufStringList   : TStringList;
 216         i                                                       : Integer;
 217 begin
 218
 219         bufStringList := TStringList.Create;
 220         try
 221                 bufStringList.Values[ 'Learned' ] := IntToStr( FLearned );
 222
 223                 for i := 0 to Count - 1 do begin
 224                         bufStringList.Add(
 225                                 IntToStr( Items[ i ].Res ) + '-' + IntToStr( Items[ i ].Option ) );
 226                 end;
 227
 228                 bufStringList.SaveToFile( FFilePath );
 229         finally
 230                 bufStringList.Free;
 231         end;
 232
 233 end;
 234
 235 constructor TAbon.Create;
 236 begin
 237         // \8f\89\8aú\89»
 238         FAbonString := '&nbsp;<>&nbsp;<>&nbsp;<>&nbsp;&nbsp;<><>';
 239         FAbonRes := TIndiviAbonList.Create;
 240         FpAbons := PChar(FAbonString);
 241         FpAbone := FpAbons + Length(FAbonString);
 242
 243 end;
 244
 245 destructor TAbon.Destroy;
 246 begin
 247         FAbonRes.Free;
 248         inherited;
 249 end;
 250 //root\82ÍExe\config\NGwords\83t\83H\83\8b\83_
 251 procedure TAbon.Setroot(root :String);
 252 var
 253         bufStringList : TStringList;
 254 begin
 255         bufStringList := TStringList.Create;
 256         try
 257                 if not DirectoryExists(root) then begin
 258                         CreateDir(root);
 259                 end;
 260                 if root[Length(root)] <> '\' then begin
 261                         root := root + '\';
 262                 end;
 263                 Flistpath := root + NGwordListFileName;
 264                 LoadListFile(Flistpath, bufStringList);
 265         finally
 266                 bufStringList.Free;
 267         end;
 268         Froot := root;
 269 end;
 270 function TAbon.Getroot() : String;
 271 begin
 272         Result := Froot;
 273 end;
 274 //NGwordpath\82ÍNGword.txt\82Ì\83t\83\8b\83p\83X
 275 procedure TAbon.SetNGwordpath(path :String);
 276 begin
 277         FNGwordpath := Getfullpath(path);
 278         LoadFromNGwordFile(FNGwordpath);
 279 end;
 280 function TAbon.GetNGwordpath() : String;
 281 begin
 282         Result :=  FNGwordpath;
 283 end;
 284 //\83t\83\8b\83p\83X\82Å\82È\82¯\82ê\82Î\83t\83\8b\83p\83X\82É\82µ\82Ä\95Ô\82·\81B
 285 function TAbon.Getfullpath(argpath : String) : String;
 286 begin
 287         if AnsiPos(':\',argpath) <> 2 then begin  //\83h\83\89\83C\83u\82©\82ç\82Ì\83t\83\8b\83p\83X\82ª\96³\82¯\82ê\82Î
 288                 if Getroot() = '' then begin
 289                         Result := '';    //root\83p\83X\82ª\90Ý\92è\82³\82ê\82Ä\82È\82¢\82©\8bó\82É\82·\82é
 290                 end else begin
 291                         if (Froot[Length(Froot)] = '\') and (argpath[1] = '\') then begin  //\90æ\93ª\82Ì\\82ð\8dí\8f\9c
 292                                 Delete(argpath,1,1);
 293                         end;
 294                         Insert( Getroot(), argpath , 1);//root\83p\83X\82ð\91}\93ü
 295                         Result := argpath;
 296                 end;
 297         end else begin
 298                 Result := argpath;
 299         end;
 300
 301 end;
 302 //NGword\83t\83@\83C\83\8b\82Ì\93Ç\82Ý\8d\9e\82Ý
 303 function TAbon.LoadFromNGwordFile(path :String) : boolean;
 304 var
 305         bufstl : TStringList;
 306 begin
 307         path := Getfullpath(path);
 308         if path = '' then begin
 309                 Result := false;
 310         end else begin
 311
 312                 bufstl := TStringList.Create;
 313                 try
 314                         if not FileExists(path) then begin
 315                                 Result := false;
 316                                 try
 317                                         bufstl.SaveToFile(path);
 318                                 except
 319                                 end;
 320                         end else begin
 321                                 bufstl.LoadFromFile(path);
 322                                 LoadFromStringList( bufstl );
 323                                 Result := true;
 324                         end;
 325                 finally
 326                         bufstl.Free;
 327                 end;
 328         end;
 329
 330 end;
 331 //NGword\83\8a\83X\83g\93Ç\82Ý\8d\9e\82Ý
 332 procedure TAbon.LoadFromStringList( bufstl : TStringList );
 333 var
 334         i : integer;
 335 begin
 336         try
 337                 for i := bufstl.Count -1  downto 0 do begin
 338                         if bufstl.Strings[i] = '' then begin
 339                                 bufstl.Delete(i);
 340                         end;
 341                 end;
 342                 SetLength(Ftokens,bufstl.Count);
 343                 for i := 0  to bufstl.Count -1 do begin
 344                         SetTokens(i , bufstl.Strings[i]);
 345                 end;
 346
 347         except
 348                 Exit;
 349         end;
 350 end;
 351 //NGwordpath\82ª\8aù\82É\90Ý\92è\82³\82ê\82Ä\82¢\82é\82Æ\82«\82Ì\83\8a\83\8d\81[\83h\97p\8aÖ\90\94
 352 function TAbon.ReLoadFromNGwordFile() : boolean;
 353 begin
 354         if GetNGwordpath() ='' then begin
 355                 Result := false;
 356         end else begin
 357                 Result := LoadFromNGwordFile( GetNGwordpath() );
 358         end;
 359 end;
 360 function TAbon.Getlistpath() : String;
 361 begin
 362         Result := Flistpath;
 363 end;
 364 procedure TAbon.Setlistpath(const Value : String);
 365 begin
 366         Flistpath := Getfullpath(Value);
 367 end;
 368 //\88ê\8ds\82Ì\92\86\82Ì\83g\81[\83N\83\93\82ð\90Ø\82è\95ª\82¯\82Ä\83Z\83b\83g
 369 procedure TAbon.SetTokens(index: integer ; argline : String);
 370 var
 371         ret : Integer;
 372         bufstl : TStringList;
 373         i : Integer;
 374         pos : Integer;
 375         buftoken : String;
 376 begin
 377         bufstl := TStringList.Create;
 378         try
 379                 if Length(argline) > 0 then begin
 380                         pos := AnsiPos(#9,argline);
 381                         while pos <> 0 DO begin
 382                                 buftoken := Copy(argline,1,pos-1);
 383                                 Delete(argline,1,pos);
 384                                 if Length(buftoken) > 0 then begin
 385                                         bufstl.Append(buftoken);
 386                                 end else if ( bufstl.Count = 0 ) then begin
 387                                         bufstl.Append('');
 388                                 end;
 389                                 pos := AnsiPos(#9,argline);
 390                         end;
 391                         if Length(argline) > 0 then begin
 392                                 bufstl.Append(argline);
 393                         end;
 394                         ret := bufstl.Count;
 395                         SetLength(Ftokens[index],ret);
 396                         for i := 0 to bufstl.Count - 1  do begin
 397                                 if IgnoreKana then
 398                                         Ftokens[index][i] := ZenToHan(bufstl.Strings[i])
 399                                 else
 400                     Ftokens[index][i] := bufstl.Strings[i];
 401                         end;
 402                 end;
 403         finally
 404                 bufstl.Free;
 405         end;
 406
 407 end;
 408 //Debug\97p\82¿\82á\82ñ\82ÆNG\83\8f\81[\83h\82ð\8fE\82¦\82Ä\82¢\82é\82©
 409 function TAbon.ShowAllTokens() : String;
 410 var
 411         i : Integer;
 412         j : Integer;
 413         ret : String;
 414 begin
 415         for i := 0 to High(Ftokens) do begin
 416                 for j := 0 to High(Ftokens[i]) do begin
 417                         ret := ret + Ftokens[i][j];
 418                 end;
 419         end;
 420         Result := ret;
 421
 422
 423
 424 end;
 425 //NG\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
 426 //\82à\82µ\82à\93§\96¾\82 \82Ú\81`\82ñ\82É\82·\82é\82È\82çInbisible\82ðtrue\82É\82µ\82Ä\95Ô\82·
 427 function TAbon.FindNGwords(const line : String; var NGwordsLineNum : Integer; var Invisible : Boolean) : Boolean; //1\83\89\83C\83\93\82¸\82Â\97p\81B
 428 var
 429         lines : Integer;
 430         cells : Integer;
 431         hit : Boolean;
 432         bufline : String;
 433         start : Integer;
 434         target : String;
 435         pos : PChar;
 436         pts, pte : PChar;
 437         trgLen : Integer;
 438 begin
 439         hit := false;
 440         if AnsiStrPosEx(PChar(line), PChar(line)+Length(line), FpAbons, FpAbone) = nil then begin
 441                 //\91S\94¼\8ap\82Ð\82ç\83J\83i\96³\8e\8b\82·\82é\82©
 442                 if IgnoreKana then
 443                         target := ZenToHan(line)
 444                 else
 445                         target := line;
 446
 447                 trgLen := Length(target);
 448
 449                 for lines := 0 to High(Ftokens) do begin
 450                         hit := true;
 451                         bufline := target;
 452                         pts := PChar(bufline);
 453                         pte := pts + trgLen;
 454
 455                         if Ftokens[lines][0] <> ''  then begin
 456                                 Invisible := false;
 457                                 start := 0;
 458                         end else begin
 459                                 Invisible := true;
 460                                 start := 1;
 461                         end;
 462
 463                         for cells := start to High(Ftokens[lines]) do begin
 464                                 pos := AnsiStrPosEx(pts, pte,
 465                                                 PChar(Ftokens[lines][cells]), PChar(Ftokens[lines][cells]) + Length(Ftokens[lines][cells]));
 466                                 if pos = nil then begin
 467                                         hit := false;
 468                                         break;
 469                                 end else begin
 470                                         Delete(bufline, pos - pte + 1, Length(Ftokens[lines][cells]));
 471                                         pts := PChar(bufline);
 472                                         pte := pts + Length(bufline);
 473                                 end;
 474                         end;
 475                         if hit = true then begin
 476                                 NGwordsLineNum := lines + 1;
 477                                 break;
 478                         end;
 479                 end;
 480         end;
 481         Result := hit;
 482 end;
 483 //\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
 484 procedure TAbon.Execute(var ThreadStrings : TStringList);
 485 var
 486         i : Integer;
 487         NGwordsLine : Integer;
 488         bufline : String;
 489         invisi : Boolean;
 490 begin
 491         for i:=0 to ThreadStrings.Count - 1 do begin
 492                 NGwordsLine := 0;
 493                 if FindNGwords(ThreadStrings.Strings[i], NGwordsLine ,invisi) <> Reverse  then begin
 494                         if invisi = true then begin
 495                                 ThreadStrings.Strings[i] := '';
 496                         end else begin
 497                                 if not ReturnNGwordLineNum and not SetNGResAnchor then begin
 498                                         ThreadStrings.Strings[i] := FAbonString;
 499                                 end else if not ReturnNGwordLineNum then begin
 500                                         ThreadStrings.Strings[i] := Format('&nbsp;<>&nbsp;<>&nbsp;<>&gt;%d<><>',[(i+1)]);
 501                                 end else if not SetNGResAnchor then begin
 502                                         ThreadStrings.Strings[i] := Format('&nbsp;<>&nbsp;<>&nbsp;<><B> %d \8ds\96Ú\82ÌNG\83\8f\81[\83h\82ª\8aÜ\82Ü\82ê\82Ä\82¢\82Ü\82·\81B</B><><>',[NGwordsLine]);
 503                                 end else begin
 504                                         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)]);
 505                                 end;
 506                         end;
 507                 end else begin
 508                         bufline := ThreadStrings.Strings[i];
 509                         if Deleterlo = true then begin
 510                                 bufline := CustomStringReplace(bufline,'&rlo;','');
 511                                 bufline := CustomStringReplace(bufline,'&lro;','');
 512                         end;
 513                         if Replaceul = true then begin
 514                                 bufline := CustomStringReplace( bufline,'<ul>','<br>' );
 515                                 bufline := CustomStringReplace( bufline,'</ul>','<br>' );
 516                         end;
 517                         if DeleteSyria = true then
 518                                 bufline := TreatSyria(bufline);
 519                         ThreadStrings.Strings[i] := bufline;
 520                 end;
 521         end;
 522 end;
 523 procedure TAbon.Execute(var ResString : String; ResNumber : Integer);
 524 var
 525         NGwordsLine : Integer;
 526         bufline : String;
 527         invisi : Boolean;
 528 begin
 529         NGwordsLine := 0;
 530         if FindNGwords(ResString, NGwordsLine ,invisi) <> Reverse  then begin
 531                 if invisi = true then begin
 532                         ResString := '';
 533                 end else begin
 534                         if not ReturnNGwordLineNum and not SetNGResAnchor then begin
 535                                 ResString := FAbonString;
 536                         end else if not ReturnNGwordLineNum then begin
 537                                 ResString := Format('&nbsp;<>&nbsp;<>&nbsp;<>&gt;%d<><>',[(ResNumber)]);
 538                         end else if not SetNGResAnchor then begin
 539                                 ResString := Format('&nbsp;<>&nbsp;<>&nbsp;<><B> %d \8ds\96Ú\82ÌNG\83\8f\81[\83h\82ª\8aÜ\82Ü\82ê\82Ä\82¢\82Ü\82·\81B</B><><>',[NGwordsLine]);
 540                         end else begin
 541                                 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)]);
 542                         end;
 543                 end;
 544         end else begin
 545                 bufline := ResString;
 546                 if Deleterlo = true then begin
 547                         bufline := CustomStringReplace( bufline,'&rlo;','' );
 548                         bufline := CustomStringReplace( bufline,'&lro;','' );
 549                 end;
 550                 if Replaceul = true then begin
 551                         bufline := CustomStringReplace( bufline,'<ul>','<br>' );
 552                         bufline := CustomStringReplace( bufline,'</ul>','<br>' );
 553                 end;
 554                 if DeleteSyria = true then
 555                         bufline := TreatSyria(bufline);
 556                 ResString := bufline;
 557         end;
 558 end;
 559
 560
 561
 562 //****************************************************************************//
 563 //\8c»\8dÝ\83Z\83b\83g\82³\82ê\82Ä\82¢\82éNGword.txt\82ð\8aJ\82
 564 procedure TAbon.EditNGwords();
 565 begin
 566         ShellExecute(0 ,nil,PChar(FNGwordpath),nil,nil,SW_SHOW);
 567 end;
 568 //\83|\83b\83v\83A\83b\83v\97p\94»\92è\8aÖ\90\94
 569 function TAbon.CheckAbonPopupRes(line : String) :Boolean;
 570 var
 571         i: Integer;
 572         v: boolean;
 573 begin
 574         if AbonPopupRes = true then begin
 575                 Result := FindNGwords(line, i ,v);
 576         end else begin
 577                 Result := false;
 578         end;
 579 end;
 580 //\95¡\90\94\82ÌNG\83\8f\81[\83h\83e\83L\83X\83g\82ð\93Ç\82Ý\8d\9e\82Þ==============================================
 581 //List\83t\83@\83C\83\8b\82ð\93Ç\82Ý\8d\9e\82Þ
 582 function TAbon.LoadListFile(path :String; listStringList : TStringList) : Boolean;
 583 begin
 584     try
 585         listStringList.LoadFromFile(path);
 586         Result := true;
 587     except
 588         listStringList.Append('\88ê\94Ê=NGword.txt');
 589         listStringList.SaveToFile(path);
 590         Result := false;
 591     end;
 592 end;
 593 //List\82Ì\88ê\82Â\8e\9f\82ÌNG\83\8f\81[\83h\83t\83@\83C\83\8b\82ð\93Ç\82Ý\8d\9e\82Þ
 594 function TAbon.GoForward() : Boolean;
 595 begin
 596     FNGwordFileIndex := FNGwordFileIndex + 1;
 597     Result := ReadNGwordslist(FNGwordFileIndex);
 598 end;
 599 //List\82Ì\88ê\82Â\91O\82ÌNG\83\8f\81[\83h\83t\83@\83C\83\8b\82ð\93Ç\82Ý\8d\9e\82Þ
 600 function TAbon.GoBack() : Boolean;
 601 begin
 602     FNGwordFileIndex := FNGwordFileIndex -1;
 603     Result := ReadNGwordslist(FNGwordFileIndex);
 604 end;
 605 //List\82Ì\82P\8ds\96Ú\82ð\93Ç\82Þ
 606 procedure TAbon.GoHome();
 607 begin
 608     FNGwordFileIndex := 0;
 609     ReadNGwordslist(FNGwordFileIndex);
 610 end;
 611 //List\82Ìline\8ds\96Ú\82ð\93Ç\82Þ
 612 function TAbon.ReadNGwordslist(line : Integer) : Boolean;
 613 var
 614     liststl : TStringList;
 615     linebuf : String;
 616 begin
 617     liststl := TStringList.Create;
 618     try
 619         if LoadListFile(Flistpath,liststl) = true then begin
 620             if line < 0 then begin
 621                 line := liststl.Count - 1;
 622                 FNGwordFileIndex := liststl.Count - 1;
 623             end else if line > liststl.Count - 1 then begin
 624                 line := 0;
 625                 FNGwordFileIndex := 0;
 626             end;
 627             linebuf := liststl.Strings[line];
 628             FNGwordname := Copy(linebuf,1,AnsiPos('=',linebuf)-1);
 629             Delete(linebuf,1,AnsiPos('=',linebuf));
 630             SetNGwordpath(linebuf);
 631             Result := true;
 632         end else begin
 633             Result := false;
 634         end
 635     finally
 636         liststl.Free;
 637     end;
 638
 639 end;
 640
 641 {$IFDEF SPAM_FILTER_ENABLED}
 642 procedure TAbon.Learn( resList : TStringList );
 643 var
 644         i, j                            : Integer;
 645         wordCount       : TWordCount;
 646         spamminess      : Extended;
 647         indiviAbon      : TIndiviAbon;
 648 const
 649         SPAM_THRESHOLD = 0.9;
 650 begin
 651
 652         if GikoSys.Setting.SpamFilterAlgorithm = gsfaNone then Exit;
 653         j := 0;
 654         wordCount := TWordCount.Create;
 655         try
 656                 if (FAbonRes.FLearned = 0) and (FAbonRes.Count = 0) then begin
 657                         // \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«
 658                         // \8cÂ\95Ê\82 \82Ú\81`\82ñ\82ð\8eg\82Á\82½\8aw\8fK
 659                         FAbonRes.Sort;
 660                         for i := 0 to FAbonRes.Count - 1 do begin
 661                                 while (j < resList.Count) and (j + 1 < FAbonRes[ j ].Res) do begin
 662                                         wordCount.Clear;
 663                                         GikoSys.Bayesian.CountWord( resList[ j ], wordCount );
 664                                         GikoSys.Bayesian.Learn( wordCount, False );
 665                                         Inc( j );
 666                                 end;
 667                                 if j < resList.Count then begin
 668                                         wordCount.Clear;
 669                                         GikoSys.Bayesian.CountWord( resList[ j ], wordCount );
 670                                         GikoSys.Bayesian.Learn( wordCount, True );
 671                                         Inc( j );
 672                                 end;
 673                         end;
 674
 675                         while j < resList.Count do begin
 676                                 wordCount.Clear;
 677                                 GikoSys.Bayesian.CountWord( resList[ j ], wordCount );
 678                                 GikoSys.Bayesian.Learn( wordCount, False );
 679                                 Inc( j );
 680                         end;
 681                 end else begin
 682                         // \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
 683                         // \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é
 684                         for j := FAbonRes.FLearned to resList.Count - 1 do begin
 685                                 wordCount.Clear;
 686                                 spamminess := GikoSys.SpamParse( resList[ j ], wordCount );
 687                                 if spamminess >= SPAM_THRESHOLD then begin
 688                                         // \83X\83p\83\80
 689                                         GikoSys.Bayesian.Learn( wordCount, True );
 690                                         indiviAbon := TIndiviAbon.Create;
 691                                         indiviAbon.Res := j + 1;
 692                                         indiviAbon.Option := 1;
 693                                         FAbonRes.Add( indiviAbon );
 694                                 end else begin
 695                                         // \83n\83\80
 696                                         GikoSys.Bayesian.Learn( wordCount, False );
 697                                 end;
 698                         end;
 699                 end;
 700
 701                 FAbonRes.FLearned := resList.Count;
 702                 FAbonRes.Save;
 703         finally
 704                 wordCount.Free;
 705         end;
 706
 707         FAbonRes.Save;
 708         GikoSys.Bayesian.Save;
 709
 710 end;
 711 {$ENDIF}
 712
 713 //\95¡\90\94\82ÌNG\83\8f\81[\83h\83e\83L\83X\83g\82ð\93Ç\82Ý\8d\9e\82Þ=====\82±\82±\82Ü\82Å=================================
 714 //\8cÂ\95Ê\82 \82Ú\81`\82ñ\8eÀ\8ds\8aÖ\90\94
 715 procedure TAbon.IndividualAbon(var ThreadStrings : TStringList; SetResNumFile : String);
 716 var
 717         i : Integer;
 718         f : Boolean;
 719 begin
 720         f := LoadFromSetResNumFile( SetResNumFile );
 721         FAbonRes.FFilePath := SetResNumFile;    // Learn \82Í\82Å\95Û\91¶\82·\82é\82Ì\82Å
 722 {$IFDEF SPAM_FILTER_ENABLED}
 723         Learn( ThreadStrings );
 724 {$ENDIF}
 725
 726         if f then begin
 727                 for i := 0 to FAbonRes.Count - 1 do begin
 728                         if (FAbonRes[i].Res <= ThreadStrings.Count) and (FAbonRes[i].Res > 0) then begin
 729 {$IFDEF NO_ABON}
 730                                 ThreadStrings.Strings[FAbonRes[i].Res-1] :=
 731                                         '<font color="red">\82 \82Ú\81`\82ñ\8dÏ\82Ý</font>' +
 732                                         ThreadStrings.Strings[FAbonRes[i].Res-1];
 733 {$ELSE}
 734                                 if FAbonRes[i].option = 0 then begin
 735                                         ThreadStrings.Strings[FAbonRes[i].Res-1] := '';
 736                                 end else begin
 737                                         ThreadStrings.Strings[FAbonRes[i].Res-1] := '\82 \82Ú\81`\82ñ<>\82 \82Ú\81`\82ñ<>\82 \82Ú\81`\82ñ<>\82 \82Ú\81`\82ñ<>';
 738                                 end;
 739 {$ENDIF}
 740                         end;
 741                 end;
 742         end;
 743 end;
 744 procedure TAbon.IndividualAbon(var ResString : String; SetResNumFile : String; ResNumber : Integer);
 745 var
 746         i : Integer;
 747 begin
 748         if FileExists(SetResNumFile) = true then begin
 749         if LoadFromSetResNumFile(SetResNumFile) = true then begin
 750                                         for i := 0 to FAbonRes.Count - 1 do begin
 751                  if FAbonRes[i].Res = ResNumber then begin
 752                         if FAbonRes[i].option = 0 then begin
 753                         ResString := '';
 754                     end else begin
 755                         ResString := '\82 \82Ú\81`\82ñ<>\82 \82Ú\81`\82ñ<>\82 \82Ú\81`\82ñ<>\82 \82Ú\81`\82ñ<>';
 756                     end;
 757                     Exit;
 758                  end;
 759             end;
 760         end;
 761     end else begin
 762                                 FIndividualFileName := SetResNumFile;
 763                                 FAbonRes.Free;
 764                                 FAbonRes := TIndiviAbonList.Create;
 765                 end;
 766 end;
 767
 768 //\8cÂ\95Ê\82 \82Ú\81`\82ñ\83t\83@\83C\83\8b\93Ç\82Ý\8d\9e\82Ý\8aÖ\90\94
 769 function TAbon.LoadFromSetResNumFile(SetResNumFile : String) : Boolean;
 770 begin
 771
 772         FIndividualFileName := SetResNumFile;
 773         FAbonRes.Free;
 774         FAbonRes := TIndiviAbonList.Create;
 775         if FileExists( SetResNumFile ) then begin
 776                 FAbonRes.LoadFromFile( SetResNumFile );
 777                 Result := true;
 778         end else begin
 779                 Result := False;
 780         end;
 781
 782 end;
 783 //\8cÂ\95Ê\82 \82Ú\81`\82ñ\83t\83@\83C\83\8b\82É\92Ç\89Á
 784 procedure TAbon.AddIndividualAbon( ResNum : Integer ; option : Integer; SetResNumFile : String);
 785 var
 786         IndividualFile : TStringList;
 787         i, j : Integer;
 788 begin
 789         IndividualFile := TStringList.Create;
 790         try
 791                 if FileExists(SetResNumFile) then begin
 792                         IndividualFile.LoadFromFile(SetResNumFile);
 793                         i := -1;
 794                         for j := 0 to IndividualFile.Count -1 do begin
 795                                 if AnsiPos(IntToStr(ResNum) + '-', IndividualFile[j]) = 1 then begin
 796                                         i := j;
 797                                         break;
 798                                 end;
 799                         end;
 800                         if i = -1 then
 801                                 IndividualFile.Add(IntToStr(ResNum) + '-' + IntToStr(option))
 802                         else
 803                                 IndividualFile[j] := IntToStr(ResNum) + '-' + IntToStr(option);
 804
 805                 end else begin
 806                         IndividualFile.Add(IntToStr(ResNum) + '-' + IntToStr(option));
 807                 end;
 808                 IndividualFile.SaveToFile(SetResNumFile);
 809         finally
 810                 IndividualFile.Free;
 811         end;
 812 end;
 813
 814 //\83|\83b\83v\83A\83b\83v\82Ì\94»\92è\97p
 815 function TAbon.CheckIndividualAbonList(ResNum : Integer) : Boolean;
 816 var
 817         i : Integer;
 818 begin
 819         if (FAbonRes.Count > 0) and (FAbonRes[0].Res <> 0) then begin
 820                 for i := 0 to FAbonRes.Count - 1 do begin
 821                         if FAbonRes[i].Res = ResNum then begin
 822                                 Result := true;
 823                                 Exit;
 824                         end;
 825                 end;
 826         end;
 827         Result := false;
 828
 829 end;
 830 //\83V\83\8a\83A\8cê\83u\83\89\83N\83\89\91Î\8dô
 831 function TAbon.TreatSyria(AString: string): string;
 832 const
 833         UNI_TAG = '&#';
 834 var
 835         //count: Integer; //(&#1792~&#1871)
 836         ps : PChar;
 837         p, pe, s, se : PChar;
 838         scode: String;
 839         icode: Integer;
 840 begin
 841
 842         Result := '';
 843
 844         p := PChar(AString);
 845         pe := p + Length(AString);
 846         s := PChar(UNI_TAG);
 847         se := s + Length(UNI_TAG);
 848
 849         p := AnsiStrPosEx(p, pe, s, se);
 850
 851         while p <> nil do begin
 852                 //&#\82Ì\8eè\91O\82Ü\82Å\83R\83s\81[\82·\82é
 853                 Result := Result + Copy(AString, 1, p - PChar(AString));
 854                 //&#\82Ì\8eè\91O\82Ü\82Å\8dí\8f\9c\82·\82é
 855                 Delete(AString, 1, p - PChar(AString));
 856
 857                 //AString\82É3\95¶\8e\9a\88È\8fã\82 \82ê\82Î\8e\9f\82Ì3\95¶\8e\9a\96Ú\82ð\83`\83F\83b\83N
 858                 if Length(AString) > 2 then begin
 859                         ps := PChar(AString) + 2;
 860                         if (ps^ = 'x') or (ps^ = 'X') then begin
 861                                 //16\90i\95\\8bL
 862                                 Inc(ps);
 863                                 scode := '0x';
 864                                 while ((ps^ >= '0') and (ps^ <= '9')) or
 865                                         ((ps^ >= 'a') and (ps^ <= 'f')) or
 866                                         ((ps^ >= 'A') and (ps^ <= 'F')) do begin
 867
 868                                         scode := scode + String(ps^);
 869                                         Inc(ps);
 870                                 end;
 871                         end else begin
 872                                 //10\90i\95\\8bL
 873                                 scode := '';
 874                                 while ((ps^ >= '0') and (ps^ <= '9')) do begin
 875                                         scode := scode + String(ps^);
 876                                         Inc(ps);
 877                                 end;
 878                         end;
 879                         icode := StrToIntDef(scode, 0);
 880
 881                         //\8dÅ\8cã\82ª;\82Å\95Â\82¶\82Ä\82¢\82È\82¯\82ê\82Î\81A\88ê\95¶\8e\9a\91O\82Ü\82Å\82É\82·\82é
 882                         if not (ps^ = ';') then
 883                                 Dec(ps);
 884
 885                         //\83V\83\8a\83A\8cê\83u\83\89\83N\83\89\82Ì\82Å\82È\82¢
 886             if ( icode < 1758) or
 887                 ((icode > 1871) and (icode < 1958)) or
 888                 (icode > 1968) then begin
 889                 Result := Result + Copy(AString, 1, ps - PChar(AString) + 1);
 890             end;
 891
 892                         Delete(AString, 1, ps - PChar(AString) + 1);
 893                 end else begin
 894             //\8cã\82ë\82É\95¶\8e\9a\82ª\96³\82¢\82Ì\82Å\81A\82»\82Ì\82Ü\82ÜResult\82É\93Ë\82Á\8d\9e\82Þ
 895                         Result := Result + AString;
 896                         AString := '';
 897                 end;
 898                 p := PChar(AString);
 899                 pe := p + Length(AString);
 900                 p := AnsiStrPosEx(p, pe, s, se);
 901         end;
 902
 903     //\8ec\82Á\82½\95¶\8e\9a\97ñ\82ð\91«\82µ\82Ä\8c\8b\89Ê\82É\82·\82é
 904         Result := Result + AString;
 905 end;
 906
 907
 908
 909 end.
 910