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                                         bufstl.Append(buftoken);
 388                                 end else if ( bufstl.Count = 0 ) then begin
 389                                         bufstl.Append('');
 390                                 end;
 391                                 pos := AnsiPos(#9,argline);
 392                         end;
 393                         if Length(argline) > 0 then begin
 394                                 bufstl.Append(argline);
 395                         end;
 396                         ret := bufstl.Count;
 397                         SetLength(Ftokens[index],ret);
 398                         for i := 0 to bufstl.Count - 1  do begin
 399                                 if IgnoreKana then
 400                                         Ftokens[index][i] := ZenToHan(bufstl.Strings[i])
 401                                 else
 402                     Ftokens[index][i] := bufstl.Strings[i];
 403                         end;
 404                 end;
 405         finally
 406                 bufstl.Free;
 407         end;
 408
 409 end;
 410 //Debug\97p\82¿\82á\82ñ\82ÆNG\83\8f\81[\83h\82ð\8fE\82¦\82Ä\82¢\82é\82©
 411 function TAbon.ShowAllTokens() : String;
 412 var
 413         i : Integer;
 414         j : Integer;
 415         ret : String;
 416 begin
 417         for i := 0 to High(Ftokens) do begin
 418                 for j := 0 to High(Ftokens[i]) do begin
 419                         ret := ret + Ftokens[i][j];
 420                 end;
 421         end;
 422         Result := ret;
 423
 424
 425
 426 end;
 427 //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
 428 //\82à\82µ\82à\93§\96¾\82 \82Ú\81`\82ñ\82É\82·\82é\82È\82çInbisible\82ðtrue\82É\82µ\82Ä\95Ô\82·
 429 function TAbon.FindNGwords(const line : String; var NGwordsLineNum : Integer; var Invisible : Boolean) : Boolean; //1\83\89\83C\83\93\82¸\82Â\97p\81B
 430 var
 431         lines : Integer;
 432         cells : Integer;
 433         hit : Boolean;
 434         bufline : String;
 435         start : Integer;
 436         target : String;
 437         pos : PChar;
 438         pts, pte : PChar;
 439         trgLen : Integer;
 440 begin
 441         hit := false;
 442         if AnsiStrPosEx(PChar(line), PChar(line)+Length(line), FpAbons, FpAbone) = nil then begin
 443                 //\91S\94¼\8ap\82Ð\82ç\83J\83i\96³\8e\8b\82·\82é\82©
 444                 if IgnoreKana then
 445                         target := ZenToHan(line)
 446                 else
 447                         target := line;
 448
 449                 trgLen := Length(target);
 450
 451                 for lines := 0 to High(Ftokens) do begin
 452                         hit := true;
 453                         bufline := target;
 454                         pts := PChar(bufline);
 455                         pte := pts + trgLen;
 456
 457                         if Ftokens[lines][0] <> ''  then begin
 458                                 Invisible := false;
 459                                 start := 0;
 460                         end else begin
 461                                 Invisible := true;
 462                                 start := 1;
 463                         end;
 464
 465                         for cells := start to High(Ftokens[lines]) do begin
 466                                 pos := AnsiStrPosEx(pts, pte,
 467                                                 PChar(Ftokens[lines][cells]), PChar(Ftokens[lines][cells]) + Length(Ftokens[lines][cells]));
 468                                 if pos = nil then begin
 469                                         hit := false;
 470                                         break;
 471                                 end else begin
 472                                         Delete(bufline, pos - pte + 1, Length(Ftokens[lines][cells]));
 473                                         pts := PChar(bufline);
 474                                         pte := pts + Length(bufline);
 475                                 end;
 476                         end;
 477                         if hit = true then begin
 478                                 NGwordsLineNum := lines + 1;
 479                                 break;
 480                         end;
 481                 end;
 482         end;
 483         Result := hit;
 484 end;
 485 //\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
 486 procedure TAbon.Execute(var ThreadStrings : TStringList);
 487 var
 488         i : Integer;
 489         NGwordsLine : Integer;
 490         bufline : String;
 491         invisi : Boolean;
 492 begin
 493         for i:=0 to ThreadStrings.Count - 1 do begin
 494                 NGwordsLine := 0;
 495                 if FindNGwords(ThreadStrings.Strings[i], NGwordsLine ,invisi) <> Reverse  then begin
 496                         if invisi = true then begin
 497                                 ThreadStrings.Strings[i] := '';
 498                         end else begin
 499                                 if not ReturnNGwordLineNum and not SetNGResAnchor then begin
 500                                         ThreadStrings.Strings[i] := FAbonString;
 501                                 end else if not ReturnNGwordLineNum then begin
 502                                         ThreadStrings.Strings[i] := Format('&nbsp;<>&nbsp;<>&nbsp;<>&gt;%d<><>',[(i+1)]);
 503                                 end else if not SetNGResAnchor then 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><><>',[NGwordsLine]);
 505                                 end else begin
 506                                         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)]);
 507                                 end;
 508                         end;
 509                 end else begin
 510                         bufline := ThreadStrings.Strings[i];
 511                         if Deleterlo = true then begin
 512                                 bufline := CustomStringReplace(bufline,'&rlo;','');
 513                                 bufline := CustomStringReplace(bufline,'&lro;','');
 514                         end;
 515                         if Replaceul = true then begin
 516                                 bufline := CustomStringReplace( bufline,'<ul>','<br>' );
 517                                 bufline := CustomStringReplace( bufline,'</ul>','<br>' );
 518                         end;
 519                         if DeleteSyria = true then
 520                                 bufline := TreatSyria(bufline);
 521                         ThreadStrings.Strings[i] := bufline;
 522                 end;
 523         end;
 524 end;
 525 procedure TAbon.Execute(var ResString : String; ResNumber : Integer);
 526 var
 527         NGwordsLine : Integer;
 528         bufline : String;
 529         invisi : Boolean;
 530 begin
 531         NGwordsLine := 0;
 532         if FindNGwords(ResString, NGwordsLine ,invisi) <> Reverse  then begin
 533                 if invisi = true then begin
 534                         ResString := '';
 535                 end else begin
 536                         if not ReturnNGwordLineNum and not SetNGResAnchor then begin
 537                                 ResString := FAbonString;
 538                         end else if not ReturnNGwordLineNum then begin
 539                                 ResString := Format('&nbsp;<>&nbsp;<>&nbsp;<>&gt;%d<><>',[(ResNumber)]);
 540                         end else if not SetNGResAnchor then 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><><>',[NGwordsLine]);
 542                         end else begin
 543                                 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)]);
 544                         end;
 545                 end;
 546         end else begin
 547                 bufline := ResString;
 548                 if Deleterlo = true then begin
 549                         bufline := CustomStringReplace( bufline,'&rlo;','' );
 550                         bufline := CustomStringReplace( bufline,'&lro;','' );
 551                 end;
 552                 if Replaceul = true then begin
 553                         bufline := CustomStringReplace( bufline,'<ul>','<br>' );
 554                         bufline := CustomStringReplace( bufline,'</ul>','<br>' );
 555                 end;
 556                 if DeleteSyria = true then
 557                         bufline := TreatSyria(bufline);
 558                 ResString := bufline;
 559         end;
 560 end;
 561
 562
 563
 564 //****************************************************************************//
 565 //\8c»\8dÝ\83Z\83b\83g\82³\82ê\82Ä\82¢\82éNGword.txt\82ð\8aJ\82
 566 procedure TAbon.EditNGwords();
 567 begin
 568         ShellExecute(0 ,nil,PChar(FNGwordpath),nil,nil,SW_SHOW);
 569 end;
 570 //\83|\83b\83v\83A\83b\83v\97p\94»\92è\8aÖ\90\94
 571 function TAbon.CheckAbonPopupRes(line : String) :Boolean;
 572 var
 573         i: Integer;
 574         v: boolean;
 575 begin
 576         if AbonPopupRes = true then begin
 577                 Result := FindNGwords(line, i ,v);
 578         end else begin
 579                 Result := false;
 580         end;
 581 end;
 582 //\95¡\90\94\82ÌNG\83\8f\81[\83h\83e\83L\83X\83g\82ð\93Ç\82Ý\8d\9e\82Þ==============================================
 583 //List\83t\83@\83C\83\8b\82ð\93Ç\82Ý\8d\9e\82Þ
 584 function TAbon.LoadListFile(path :String; listStringList : TStringList) : Boolean;
 585 begin
 586     try
 587         listStringList.LoadFromFile(path);
 588         Result := true;
 589     except
 590         listStringList.Append('\88ê\94Ê=NGword.txt');
 591         listStringList.SaveToFile(path);
 592         Result := false;
 593     end;
 594 end;
 595 //List\82Ì\88ê\82Â\8e\9f\82ÌNG\83\8f\81[\83h\83t\83@\83C\83\8b\82ð\93Ç\82Ý\8d\9e\82Þ
 596 function TAbon.GoForward() : Boolean;
 597 begin
 598     FNGwordFileIndex := FNGwordFileIndex + 1;
 599     Result := ReadNGwordslist(FNGwordFileIndex);
 600 end;
 601 //List\82Ì\88ê\82Â\91O\82ÌNG\83\8f\81[\83h\83t\83@\83C\83\8b\82ð\93Ç\82Ý\8d\9e\82Þ
 602 function TAbon.GoBack() : Boolean;
 603 begin
 604     FNGwordFileIndex := FNGwordFileIndex -1;
 605     Result := ReadNGwordslist(FNGwordFileIndex);
 606 end;
 607 //List\82Ì\82P\8ds\96Ú\82ð\93Ç\82Þ
 608 procedure TAbon.GoHome();
 609 begin
 610     FNGwordFileIndex := 0;
 611     ReadNGwordslist(FNGwordFileIndex);
 612 end;
 613 //List\82Ìline\8ds\96Ú\82ð\93Ç\82Þ
 614 function TAbon.ReadNGwordslist(line : Integer) : Boolean;
 615 var
 616     liststl : TStringList;
 617     linebuf : String;
 618 begin
 619     liststl := TStringList.Create;
 620     try
 621         if LoadListFile(Flistpath,liststl) = true then begin
 622             if line < 0 then begin
 623                 line := liststl.Count - 1;
 624                 FNGwordFileIndex := liststl.Count - 1;
 625             end else if line > liststl.Count - 1 then begin
 626                 line := 0;
 627                 FNGwordFileIndex := 0;
 628             end;
 629             linebuf := liststl.Strings[line];
 630             FNGwordname := Copy(linebuf,1,AnsiPos('=',linebuf)-1);
 631             Delete(linebuf,1,AnsiPos('=',linebuf));
 632             SetNGwordpath(linebuf);
 633             Result := true;
 634         end else begin
 635             Result := false;
 636         end
 637     finally
 638         liststl.Free;
 639     end;
 640
 641 end;
 642
 643 {$IFDEF SPAM_FILTER_ENABLED}
 644 procedure TAbon.Learn( resList : TStringList );
 645 var
 646         i, j                            : Integer;
 647         wordCount       : TWordCount;
 648         spamminess      : Extended;
 649         indiviAbon      : TIndiviAbon;
 650 const
 651         SPAM_THRESHOLD = 0.9;
 652 begin
 653
 654         if GikoSys.Setting.SpamFilterAlgorithm = gsfaNone then Exit;
 655         j := 0;
 656         wordCount := TWordCount.Create;
 657         try
 658                 if (FAbonRes.FLearned = 0) and (FAbonRes.Count = 0) then begin
 659                         // \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«
 660                         // \8cÂ\95Ê\82 \82Ú\81`\82ñ\82ð\8eg\82Á\82½\8aw\8fK
 661                         FAbonRes.Sort;
 662                         for i := 0 to FAbonRes.Count - 1 do begin
 663                                 while (j < resList.Count) and (j + 1 < FAbonRes[ j ].Res) do begin
 664                                         wordCount.Clear;
 665                                         GikoSys.Bayesian.CountWord( resList[ j ], wordCount );
 666                                         GikoSys.Bayesian.Learn( wordCount, False );
 667                                         Inc( j );
 668                                 end;
 669                                 if j < resList.Count then begin
 670                                         wordCount.Clear;
 671                                         GikoSys.Bayesian.CountWord( resList[ j ], wordCount );
 672                                         GikoSys.Bayesian.Learn( wordCount, True );
 673                                         Inc( j );
 674                                 end;
 675                         end;
 676
 677                         while j < resList.Count do begin
 678                                 wordCount.Clear;
 679                                 GikoSys.Bayesian.CountWord( resList[ j ], wordCount );
 680                                 GikoSys.Bayesian.Learn( wordCount, False );
 681                                 Inc( j );
 682                         end;
 683                 end else begin
 684                         // \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
 685                         // \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é
 686                         for j := FAbonRes.FLearned to resList.Count - 1 do begin
 687                                 wordCount.Clear;
 688                                 spamminess := GikoSys.SpamParse( resList[ j ], wordCount );
 689                                 if spamminess >= SPAM_THRESHOLD then begin
 690                                         // \83X\83p\83\80
 691                                         GikoSys.Bayesian.Learn( wordCount, True );
 692                                         indiviAbon := TIndiviAbon.Create;
 693                                         indiviAbon.Res := j + 1;
 694                                         indiviAbon.Option := 1;
 695                                         FAbonRes.Add( indiviAbon );
 696                                 end else begin
 697                                         // \83n\83\80
 698                                         GikoSys.Bayesian.Learn( wordCount, False );
 699                                 end;
 700                         end;
 701                 end;
 702
 703                 FAbonRes.FLearned := resList.Count;
 704                 FAbonRes.Save;
 705         finally
 706                 wordCount.Free;
 707         end;
 708
 709         FAbonRes.Save;
 710         GikoSys.Bayesian.Save;
 711
 712 end;
 713 {$ENDIF}
 714
 715 //\95¡\90\94\82ÌNG\83\8f\81[\83h\83e\83L\83X\83g\82ð\93Ç\82Ý\8d\9e\82Þ=====\82±\82±\82Ü\82Å=================================
 716 //\8cÂ\95Ê\82 \82Ú\81`\82ñ\8eÀ\8ds\8aÖ\90\94
 717 procedure TAbon.IndividualAbon(var ThreadStrings : TStringList; SetResNumFile : String);
 718 var
 719         i : Integer;
 720         f : Boolean;
 721 begin
 722         f := LoadFromSetResNumFile( SetResNumFile );
 723         FAbonRes.FFilePath := SetResNumFile;    // Learn \82Í\82Å\95Û\91¶\82·\82é\82Ì\82Å
 724 {$IFDEF SPAM_FILTER_ENABLED}
 725         Learn( ThreadStrings );
 726 {$ENDIF}
 727
 728         if f then begin
 729                 for i := 0 to FAbonRes.Count - 1 do begin
 730                         if (FAbonRes[i].Res <= ThreadStrings.Count) and (FAbonRes[i].Res > 0) then begin
 731 {$IFDEF NO_ABON}
 732                                 ThreadStrings.Strings[FAbonRes[i].Res-1] :=
 733                                         '<font color="red">\82 \82Ú\81`\82ñ\8dÏ\82Ý</font>' +
 734                                         ThreadStrings.Strings[FAbonRes[i].Res-1];
 735 {$ELSE}
 736                                 if FAbonRes[i].option = 0 then begin
 737                                         ThreadStrings.Strings[FAbonRes[i].Res-1] := '';
 738                                 end else begin
 739                                         ThreadStrings.Strings[FAbonRes[i].Res-1] := '\82 \82Ú\81`\82ñ<>\82 \82Ú\81`\82ñ<>\82 \82Ú\81`\82ñ<>\82 \82Ú\81`\82ñ<>';
 740                                 end;
 741 {$ENDIF}
 742                         end;
 743                 end;
 744         end;
 745 end;
 746 procedure TAbon.IndividualAbon(var ResString : String; SetResNumFile : String; ResNumber : Integer);
 747 var
 748         i : Integer;
 749 begin
 750         if FileExists(SetResNumFile) = true then begin
 751         if LoadFromSetResNumFile(SetResNumFile) = true then begin
 752                                         for i := 0 to FAbonRes.Count - 1 do begin
 753                  if FAbonRes[i].Res = ResNumber then begin
 754                         if FAbonRes[i].option = 0 then begin
 755                         ResString := '';
 756                     end else begin
 757                         ResString := '\82 \82Ú\81`\82ñ<>\82 \82Ú\81`\82ñ<>\82 \82Ú\81`\82ñ<>\82 \82Ú\81`\82ñ<>';
 758                     end;
 759                     Exit;
 760                  end;
 761             end;
 762         end;
 763     end else begin
 764                                 FIndividualFileName := SetResNumFile;
 765                                 FAbonRes.Free;
 766                                 FAbonRes := TIndiviAbonList.Create;
 767                 end;
 768 end;
 769
 770 //\8cÂ\95Ê\82 \82Ú\81`\82ñ\83t\83@\83C\83\8b\93Ç\82Ý\8d\9e\82Ý\8aÖ\90\94
 771 function TAbon.LoadFromSetResNumFile(SetResNumFile : String) : Boolean;
 772 begin
 773
 774         FIndividualFileName := SetResNumFile;
 775         FAbonRes.Free;
 776         FAbonRes := TIndiviAbonList.Create;
 777         if FileExists( SetResNumFile ) then begin
 778                 FAbonRes.LoadFromFile( SetResNumFile );
 779                 Result := true;
 780         end else begin
 781                 Result := False;
 782         end;
 783
 784 end;
 785 //\8cÂ\95Ê\82 \82Ú\81`\82ñ\83t\83@\83C\83\8b\82É\92Ç\89Á
 786 procedure TAbon.AddIndividualAbon( ResNum : Integer ; option : Integer; SetResNumFile : String);
 787 var
 788         IndividualFile : TStringList;
 789         i, j : Integer;
 790 begin
 791         IndividualFile := TStringList.Create;
 792         try
 793                 if FileExists(SetResNumFile) then begin
 794                         IndividualFile.LoadFromFile(SetResNumFile);
 795                         i := -1;
 796                         for j := 0 to IndividualFile.Count -1 do begin
 797                                 if AnsiPos(IntToStr(ResNum) + '-', IndividualFile[j]) = 1 then begin
 798                                         i := j;
 799                                         break;
 800                                 end;
 801                         end;
 802                         if i = -1 then
 803                                 IndividualFile.Add(IntToStr(ResNum) + '-' + IntToStr(option))
 804                         else
 805                                 IndividualFile[j] := IntToStr(ResNum) + '-' + IntToStr(option);
 806
 807                 end else begin
 808                         IndividualFile.Add(IntToStr(ResNum) + '-' + IntToStr(option));
 809                 end;
 810                 IndividualFile.SaveToFile(SetResNumFile);
 811         finally
 812                 IndividualFile.Free;
 813         end;
 814 end;
 815
 816 //\83|\83b\83v\83A\83b\83v\82Ì\94»\92è\97p
 817 function TAbon.CheckIndividualAbonList(ResNum : Integer) : Boolean;
 818 var
 819         i : Integer;
 820 begin
 821         if (FAbonRes.Count > 0) and (FAbonRes[0].Res <> 0) then begin
 822                 for i := 0 to FAbonRes.Count - 1 do begin
 823                         if FAbonRes[i].Res = ResNum then begin
 824                                 Result := true;
 825                                 Exit;
 826                         end;
 827                 end;
 828         end;
 829         Result := false;
 830
 831 end;
 832 //\83V\83\8a\83A\8cê\83u\83\89\83N\83\89\91Î\8dô
 833 function TAbon.TreatSyria(AString: string): string;
 834 const
 835         UNI_TAG = '&#';
 836 var
 837         //count: Integer; //(&#1792~&#1871)
 838         ps : PChar;
 839         p, pe, s, se : PChar;
 840         scode: String;
 841         icode: Integer;
 842 begin
 843
 844         Result := '';
 845
 846         p := PChar(AString);
 847         pe := p + Length(AString);
 848         s := PChar(UNI_TAG);
 849         se := s + Length(UNI_TAG);
 850
 851         p := AnsiStrPosEx(p, pe, s, se);
 852
 853         while p <> nil do begin
 854                 //&#\82Ì\8eè\91O\82Ü\82Å\83R\83s\81[\82·\82é
 855                 Result := Result + Copy(AString, 1, p - PChar(AString));
 856                 //&#\82Ì\8eè\91O\82Ü\82Å\8dí\8f\9c\82·\82é
 857                 Delete(AString, 1, p - PChar(AString));
 858
 859                 //AString\82É3\95¶\8e\9a\88È\8fã\82 \82ê\82Î\8e\9f\82Ì3\95¶\8e\9a\96Ú\82ð\83`\83F\83b\83N
 860                 if Length(AString) > 2 then begin
 861                         ps := PChar(AString) + 2;
 862                         if (ps^ = 'x') or (ps^ = 'X') then begin
 863                                 //16\90i\95\\8bL
 864                                 Inc(ps);
 865                                 scode := '0x';
 866                                 while ((ps^ >= '0') and (ps^ <= '9')) or
 867                                         ((ps^ >= 'a') and (ps^ <= 'f')) or
 868                                         ((ps^ >= 'A') and (ps^ <= 'F')) do begin
 869
 870                                         scode := scode + String(ps^);
 871                                         Inc(ps);
 872                                 end;
 873                         end else begin
 874                                 //10\90i\95\\8bL
 875                                 scode := '';
 876                                 while ((ps^ >= '0') and (ps^ <= '9')) do begin
 877                                         scode := scode + String(ps^);
 878                                         Inc(ps);
 879                                 end;
 880                         end;
 881                         icode := StrToIntDef(scode, 0);
 882
 883                         //\8dÅ\8cã\82ª;\82Å\95Â\82¶\82Ä\82¢\82È\82¯\82ê\82Î\81A\88ê\95¶\8e\9a\91O\82Ü\82Å\82É\82·\82é
 884                         if not (ps^ = ';') then
 885                                 Dec(ps);
 886
 887                         //\83V\83\8a\83A\8cê\83u\83\89\83N\83\89\82Ì\82Å\82È\82¢
 888             if ( icode < 1758) or
 889                 ((icode > 1871) and (icode < 1958)) or
 890                 (icode > 1968) then begin
 891                 Result := Result + Copy(AString, 1, ps - PChar(AString) + 1);
 892             end;
 893
 894                         Delete(AString, 1, ps - PChar(AString) + 1);
 895                 end else begin
 896             //\8cã\82ë\82É\95¶\8e\9a\82ª\96³\82¢\82Ì\82Å\81A\82»\82Ì\82Ü\82ÜResult\82É\93Ë\82Á\8d\9e\82Þ
 897                         Result := Result + AString;
 898                         AString := '';
 899                 end;
 900                 p := PChar(AString);
 901                 pe := p + Length(AString);
 902                 p := AnsiStrPosEx(p, pe, s, se);
 903         end;
 904
 905     //\8ec\82Á\82½\95¶\8e\9a\97ñ\82ð\91«\82µ\82Ä\8c\8b\89Ê\82É\82·\82é
 906         Result := Result + AString;
 907 end;
 908
 909 // 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é
 910 function TAbon.AddToken(AString: string; Invisible: Boolean): Boolean;
 911 var
 912         bufStringList : TStringList;
 913     ngword: String;
 914 begin
 915     Result := False;
 916     if FileExists(GetNGwordpath) then begin
 917         bufStringList := TStringList.Create;
 918         try
 919             bufStringList.LoadFromFile(GetNGwordpath);
 920             if (Invisible) then begin
 921                 ngword := #9 + AString;
 922             end else begin
 923                 ngword := AString;
 924             end;
 925             if (bufStringList.IndexOf(ngword) = -1) then begin
 926                 bufStringList.Add(ngword);
 927                 bufStringList.SaveToFile(GetNGwordpath);
 928                 Result := True;
 929             end;
 930         finally
 931             bufStringList.Free;
 932         end;
 933     end;
 934 end;
 935
 936
 937 end.
 938