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