AbonUnit.pas

   1 unit AbonUnit;
   2
   3 interface
   4 uses
   5     Windows,Messages, ShellAPI, SysUtils, Classes,StdCtrls,StrUtils;
   6
   7 type
   8   TAbon = class(TObject)
   9   private
  10     { Private \90é\8c¾ }
  11     Froot : String;
  12     FNGwordpath : String;
  13     Ftokens : array of array of string;
  14     FAbonString : String;
  15     FCutoffNum : Integer; //\82±\82Ì\90\94\88È\8fã\98A\91±\82·\82é\93¯\82¶\89p\8e\9a\82ðNG\83\8f\81[\83h\82Æ\82·\82é
  16     FDeleterlo : Boolean; //&rlo;\82ð\8dí\82é\82©
  17     FReplaceul :Boolean ; //<ul>\83^\83O\82ð<br>\83^\83O\82É\92u\8a·\82·\82é\82©
  18     FReverse : Boolean ;  //NG\83\8f\81[\83h\82Å\82Ì\82 \82Ú\81`\82ñ\82Ì\8c\8b\89Ê\82ð\94½\93]\82³\82¹\82é\82©
  19     FAbonPopupRes : Boolean; //\83\8c\83X\83|\83b\83v\83A\83b\83v\82Ì\8e\9e\82É\82 \82Ú\81[\82ñ\82·\82é\82©
  20     FCreateNGwordFile : Boolean; //\8ew\92è\82³\82ê\82½path\82ÉNG\83\8f\81[\83htxt\82ª\96³\82©\82Á\82½\82Æ\82«\82É\8e©\93®\93I\82É\90¶\90¬\82·\82é\82©
  21     procedure SetTokens(index: integer ; argline:String);
  22
  23   public
  24     { Public \90é\8c¾ }
  25     constructor Create; // \83R\83\93\83X\83g\83\89\83N\83^
  26     destructor Destroy; override; // \83f\83X\83g\83\89\83N\83^
  27     property Deleterlo: Boolean read FDeleterlo write FDeleterlo  default false;
  28     property Replaceul: Boolean read FReplaceul write FReplaceul  default false;
  29     property Reverse: Boolean read FReverse write FReverse  default false;
  30     property CreateNGwordFile: Boolean read FCreateNGwordFile write FCreateNGwordFile;
  31     property AbonString : String read FAbonString write FAbonString;
  32     property  AbonPopupRes : Boolean read FAbonPopupRes write FAbonPopupRes default false;
  33     procedure Setroot(root :String);
  34     function Getroot() : String;
  35     procedure SetNGwordpath(path :String);
  36     function GetNGwordpath() : String;
  37     procedure SetCutoffNum(value : Integer);
  38     function GetCutoffNum() : Integer;
  39     function LoadFromNGwordFile(path :String) : Boolean;
  40     function ReLoadFromNGwordFile() : Boolean;
  41     procedure LoadFromStringList( bufstl : TStringList );
  42     function CheckAbonPopupRes(line : String) :Boolean;
  43     function FindNGwords(line : String) : Boolean; //1\83\89\83C\83\93\82¸\82Â\97p\81B
  44     function Cutoff(line : String) : Boolean; //CutOff\92l\88È\8fã\8cÂ\82Ì\93¯\82¶\89p\90\94\82ª\95À\82ñ\82Å\82¢\82½\82çtrue
  45     //\82 \82Ú\81`\82ñ\8f\88\97\9d
  46     procedure Execute(var ThreadStrings : TStringList); overload;
  47     procedure Execute(var ThreadStrings : TStringList; NGwords : TStringList); overload;
  48     procedure Execute(var ThreadStrings : TStringList; NGwords : TStrings); overload;
  49     //--
  50     function ExecuteFile(datfilepath : String; NGwordpath : String) : Boolean; overload;//DAT\83t\83@\83C\83\8b\82ð\92¼\82É\82¢\82¶\82é
  51     function ExecuteFile(datfilepath : String; resnum : Integer) : Boolean; overload; //DAT\83t\83@\83C\83\8b\82ð\92¼\82É\82¢\82¶\82é
  52     function ExecuteFile(datfilepath : String; firstres : Integer; count : Integer) : Boolean; overload; //DAT\83t\83@\83C\83\8b\82ð\92¼\82É\82¢\82¶\82é
  53     function ReverseExecuteFile(datfilepath : String) : Boolean; overload; //DAT\83t\83@\83C\83\8b\82ð\92¼\82É\82¢\82¶\82é
  54     function ReverseExecuteFile(datfilepath : String; resnum : Integer) : Boolean; overload; //DAT\83t\83@\83C\83\8b\82ð\92¼\82É\82¢\82¶\82é
  55     function ReverseExecuteFile(datfilepath : String; firstres : Integer; count : Integer) : Boolean; overload; //DAT\83t\83@\83C\83\8b\82ð\92¼\82É\82¢\82¶\82é
  56     //--
  57     procedure EditNGwords();  //NGword.txt\82ð\8aJ\82\81B
  58     function ShowAllTokens() : String;  //\83f\83o\83b\83O\97p
  59   end;
  60 var
  61     Abon1 :TAbon;
  62
  63 implementation
  64
  65 constructor TAbon.Create;
  66 begin
  67     // \8f\89\8aú\89»
  68     FAbonString := '&nbsp;<>&nbsp;<>&nbsp;<>&nbsp;&nbsp;<><>';
  69     //FRetStrings := TStringList.Create;
  70     FCreateNGwordFile := true;
  71     SetCutoffNum(0);
  72 end;
  73
  74 destructor TAbon.Destroy;
  75 begin
  76     //FRetStrings.Free;
  77     inherited;
  78 end;
  79
  80
  81
  82 //root\82ÍExe\82Ì\82¢\82é\83t\83H\83\8b\83_
  83 procedure TAbon.Setroot(root :String);
  84 begin
  85     Froot := root;
  86 end;
  87 function TAbon.Getroot() : String;
  88 begin
  89     Result := Froot;
  90 end;
  91 //NGwordpath\82ÍNGword.txt\82Ì\83t\83\8b\83p\83X
  92 procedure TAbon.SetNGwordpath(path :String);
  93 begin
  94     FNGwordpath := path;
  95     LoadFromNGwordFile(FNGwordpath);
  96 end;
  97 function TAbon.GetNGwordpath() : String;
  98 begin
  99     Result :=  FNGwordpath;
 100 end;
 101 //NGword\83t\83@\83C\83\8b\82Ì\93Ç\82Ý\8d\9e\82Ý
 102 function TAbon.LoadFromNGwordFile(path :String) : boolean;
 103 var
 104     bufstl : TStringList;
 105     i : integer;
 106 begin
 107     if AnsiPos(':\',path) <> 2 then begin  //\83h\83\89\83C\83u\82©\82ç\82Ì\83t\83\8b\83p\83X\82ª\96³\82¯\82ê\82Î
 108         if Getroot() = '' then begin
 109             Result := false;    //root\83p\83X\82ª\90Ý\92è\82³\82ê\82Ä\82È\82¢\82©\82çfalse
 110             Exit;
 111         end else begin
 112             if (Froot[Length(Froot)] = '\') and (path[1] = '\') then begin  //\90æ\93ª\82Ì\\82ð\8dí\8f\9c
 113                 Delete(path,1,1);
 114             end;
 115             Insert( Getroot(), path , 1);//root\83p\83X\82ð\91}\93ü
 116         end;
 117     end;
 118     bufstl := TStringList.Create;
 119     try
 120         bufstl.LoadFromFile(path);
 121         LoadFromStringList( bufstl );
 122
 123     except
 124         if CreateNGwordFile = true then begin
 125             bufstl.SaveToFile(path);
 126         end;
 127         bufstl.Free;
 128         Result := false;
 129         Exit;
 130     end;
 131     bufstl.Free;
 132     Result := true;
 133 end;
 134 //NGword\83\8a\83X\83g\93Ç\82Ý\8d\9e\82Ý
 135 procedure TAbon.LoadFromStringList( bufstl : TStringList );
 136 var
 137     i : integer;
 138 begin
 139     try
 140         for i := bufstl.Count -1  downto 0 do begin
 141             if bufstl.Strings[i] = '' then begin
 142                 bufstl.Delete(i);
 143             end;
 144         end;
 145         SetLength(Ftokens,bufstl.Count);
 146         for i := 0  to bufstl.Count -1 do begin
 147             SetTokens(i , bufstl.Strings[i]);
 148         end;
 149
 150     except
 151         Exit;
 152     end;
 153 end;
 154 //NGwordpath\82ª\8aù\82É\90Ý\92è\82³\82ê\82Ä\82¢\82é\82Æ\82«\82Ì\83\8a\83\8d\81[\83h\97p\8aÖ\90\94
 155 function TAbon.ReLoadFromNGwordFile() : boolean;
 156 begin
 157     if GetNGwordpath() ='' then begin
 158         Result := false;
 159     end else begin
 160         Result := LoadFromNGwordFile( GetNGwordpath() );
 161     end;
 162 end;
 163
 164 //\88ê\8ds\82Ì\92\86\82Ì\83g\81[\83N\83\93\82ð\90Ø\82è\95ª\82¯\82Ä\83Z\83b\83g
 165 procedure TAbon.SetTokens(index: integer ; argline : String);
 166 var
 167     ret : Integer;
 168     bufstl : TStringList;
 169     i : Integer;
 170 begin
 171     bufstl := TStringList.Create;
 172     bufstl.Delimiter := #9;  //\8bæ\90Ø\82è\8eq\82ð\81f\83^\83u\81f\82É\90Ý\92è
 173     bufstl.DelimitedText := argline;
 174     ret := bufstl.Count;
 175     SetLength(Ftokens[index],ret);
 176     for i := 0 to bufstl.Count - 1  do begin
 177         Ftokens[index][i] := bufstl.Strings[i];
 178     end;
 179     bufstl.Free;
 180
 181 end;
 182 procedure TAbon.SetCutoffNum(value : Integer);
 183 begin
 184     if value > 0 then begin
 185         FCutoffNum := value;
 186     end else begin
 187         FCutoffNum := 0;
 188     end;
 189 end;
 190 function TAbon.GetCutoffNum() : Integer;
 191 begin
 192     Result := FCutoffNum;
 193 end;
 194 function TAbon.ShowAllTokens() : String;
 195 var
 196     i : Integer;
 197     j : Integer;
 198     ret : String;
 199 begin
 200     for i := 0 to High(Ftokens) do begin
 201         for j := 0 to High(Ftokens[i]) do begin
 202             ret := ret + Ftokens[i][j];
 203         end;
 204     end;
 205     Result := ret;
 206
 207
 208
 209 end;
 210
 211 //****************************************************************************//
 212 //NG\83\8f\81[\83h\82ª\8aÜ\82Ü\82ê\82Ä\82½\82çtrue\82ð\95Ô\82·\81B
 213 function TAbon.FindNGwords(line : String) : Boolean;
 214 var
 215     i : Integer;
 216     j : Integer;
 217     hit : Boolean;
 218 begin
 219     hit := false;
 220     if AnsiPos(FAbonString,line) <> 1 then begin
 221         for i := 0 to High(Ftokens) do begin
 222             hit := true;
 223             for j := 0 to High(Ftokens[i]) do begin
 224                 if AnsiPos(Ftokens[i][j],line) = 0 then begin
 225                     hit := false;
 226                     break;
 227                 end;
 228             end;
 229             if hit = true then begin
 230                 break;
 231             end;
 232         end;
 233     end;
 234     Result := hit;
 235
 236 end;
 237 //CutOff\92l\88È\8fã\8cÂ\82Ì\93¯\82¶\89p\90\94\82ª\95À\82ñ\82Å\82¢\82½\82çtrue
 238 function TAbon.Cutoff(line : String) : Boolean;
 239 var
 240     i : Integer;
 241     sheed : AnsiChar;
 242     buf : String;
 243     ret : Bool;
 244 begin
 245     ret := false;
 246     if FCutoffNum <> 0 then begin
 247         for i := 65 to 90 do begin
 248             sheed := Chr(i);
 249             buf := DupeString(sheed, FCutoffNum);
 250             if AnsiContainsText(line, buf) = true then begin
 251                 ret := true;
 252                 break;
 253             end;
 254         end;
 255     end;
 256     Result := ret;
 257 end;
 258 //\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
 259 procedure TAbon.Execute(var ThreadStrings : TStringList);
 260 var
 261     i : Integer;
 262     j : Integer;
 263     bufline : String;
 264 begin
 265     //FRetStrings.Clear;
 266
 267     for i:=0 to ThreadStrings.Count - 1 do begin
 268         if FindNGwords(ThreadStrings.Strings[i]) <> Reverse  then begin
 269             ThreadStrings.Strings[i] := FAbonString;
 270         end else if FCutoffNum > 0  then begin
 271             bufline := ThreadStrings.Strings[i];
 272             for j := 0 to 2 do begin
 273                 Delete(bufline,1,Ansipos('<>',bufline)+1);
 274             end;
 275             Delete(bufline,Ansipos('<>',bufline),Length(bufline)-Ansipos('<>',bufline)+1);
 276             if Cutoff(bufline) = true then begin
 277                 ThreadStrings.Strings[i] := FAbonString;
 278             end else begin
 279                 bufline := ThreadStrings.Strings[i];
 280                 if Deleterlo = true then begin
 281                     bufline := AnsiReplaceText( bufline,'&rlo;','' );
 282                 end;
 283                 if Replaceul = true then begin
 284                     bufline := AnsiReplaceText( bufline,'<ul>','<br>' );
 285                     bufline := AnsiReplaceText( bufline,'</ul>','<br>' );
 286                 end;
 287                 ThreadStrings.Strings[i] := bufline;
 288             end;
 289         end else begin
 290             bufline := ThreadStrings.Strings[i];
 291             if Deleterlo = true then begin
 292                 bufline := AnsiReplaceText( bufline,'&rlo;','' );
 293             end;
 294             if Replaceul = true then begin
 295                 bufline := AnsiReplaceText( bufline,'<ul>','<br>' );
 296                 bufline := AnsiReplaceText( bufline,'</ul>','<br>' );
 297             end;
 298             ThreadStrings.Strings[i] := bufline;
 299         end;
 300     end;
 301     //Result := FRetStrings;
 302
 303 end;
 304 procedure TAbon.Execute(var ThreadStrings : TStringList; NGwords : TStringList);
 305 var
 306     i : Integer;
 307 begin
 308     SetLength(Ftokens,NGwords.Count);
 309     for i := 0  to NGwords.Count -1 do begin
 310         SetTokens(i , NGwords.Strings[i]);
 311     end;
 312     Execute(ThreadStrings);
 313
 314 end;
 315 procedure TAbon.Execute(var ThreadStrings : TStringList; NGwords : TStrings);
 316 var
 317     i : Integer;
 318     buf : TStringList;
 319 begin
 320     buf := TStringList.Create;
 321     buf.AddStrings(NGwords);
 322     SetLength(Ftokens,buf.Count);
 323     for i := 0  to buf.Count -1 do begin
 324         SetTokens(i , buf.Strings[i]);
 325     end;
 326     Execute(ThreadStrings);
 327     buf.Free;
 328 end;
 329
 330
 331 //****************************************************************************//
 332 //DAT\82ð\92¼\82É\82¢\82¶\82é\93z\82ç===========================================================
 333 //NG\83\8f\81[\83h\82ð\8aÜ\82Þ\83\8c\83X\82Ì\90æ\93ª\82É\82 \82Ú\81[\82ñ\82ð\91}\93ü
 334 function TAbon.ExecuteFile(datfilepath : String; NGwordpath : String) : Boolean; //DAT\83t\83@\83C\83\8b\82ð\92¼\82É\82¢\82¶\82é
 335 var
 336     datstl : TStringList;
 337     ret : Boolean;
 338     i : Integer;
 339 begin
 340     datstl := TStringList.Create;
 341     ret := true;
 342     try
 343         try
 344             datstl.LoadFromFile(datfilepath);
 345             for i := 0 to datstl.Count -1 do begin
 346                 if FindNGwords(datstl.Strings[i]) = true  then begin
 347                     datstl.Strings[i] := FAbonString + datstl.Strings[i]
 348                 end;
 349             end;
 350
 351             datstl.SaveToFile(datfilepath);
 352         except
 353             ret := false;
 354         end;
 355     finally
 356         datstl.Free;
 357     end;
 358     Result := ret;
 359
 360 end;
 361 //\8ew\92è\82³\82ê\82½\83\8c\83X\94Ô\82Ì\90æ\93ª\82É\82 \82Ú\81[\82ñ\91}\93ü
 362 function TAbon.ExecuteFile(datfilepath : String; resnum : Integer) : Boolean; //DAT\83t\83@\83C\83\8b\82ð\92¼\82É\82¢\82¶\82é
 363 var
 364     datstl : TStringList;
 365     ret : Boolean;
 366 begin
 367     ret := true;
 368     datstl := TStringList.Create;
 369     try
 370         try
 371             datstl.LoadFromFile(datfilepath);
 372             if (resnum > 0) and (resnum <= datstl.Count) then begin
 373                 if AnsiPos(FAbonString, datstl.Strings[resnum-1]) <> 1 then begin
 374                     datstl.Strings[resnum-1] := FAbonString + datstl.Strings[resnum-1];
 375                 end;
 376             end;
 377             datstl.SaveToFile(datfilepath);
 378         except
 379             ret := false;
 380         end;
 381     finally
 382         datstl.Free;
 383     end;
 384     Result := ret;
 385 end;
 386 //firstres\82©\82çcount\8cÂ\82Ì\83\8c\83X\82Ì\90æ\93ª\82É\82 \82Ú\81[\82ñ\91}\93ü
 387 function TAbon.ExecuteFile(datfilepath : String; firstres : Integer; count : Integer) : Boolean; //DAT\83t\83@\83C\83\8b\82ð\92¼\82É\82¢\82¶\82é
 388 var
 389     datstl : TStringList;
 390     i : Integer;
 391     endnum : Integer; //\8fI\82í\82è\82Ì\83\8c\83X\94Ô
 392     ret : Boolean;
 393 begin
 394     ret := true;
 395     datstl := TStringList.Create;
 396     try
 397         try
 398             datstl.LoadFromFile(datfilepath);
 399             if (firstres > 0) and (firstres <= datstl.Count) then begin
 400                 if firstres + count -1 > datstl.Count then begin
 401                     endnum := datstl.Count;
 402                 end else if count <= 0 then begin
 403                     endnum := firstres + 1;
 404                 end else begin
 405                     endnum := firstres + count -1;
 406                 end;
 407
 408                 for i := firstres to endnum do begin
 409                     if AnsiPos(FAbonString, datstl.Strings[i-1]) <> 1 then begin
 410                         datstl.Strings[i-1] := FAbonString + datstl.Strings[i-1];
 411                     end;
 412                 end;
 413             end;
 414             datstl.SaveToFile(datfilepath);
 415         except
 416             ret := false;
 417         end;
 418     finally
 419         datstl.Free;
 420     end;
 421     Result := ret;
 422 end;
 423 //DAT\82ð\92¼\82É\82¢\82¶\82é\93z\82ç==========\82±\82±\82Ü\82Å=========================================
 424
 425 //\8c³\82É\96ß\82·\93z\82ç==================================================================
 426 function TAbon.ReverseExecuteFile(datfilepath : String) : Boolean; //DAT\83t\83@\83C\83\8b\82ð\92¼\82É\82¢\82¶\82é
 427 var
 428     datstl : TStringList;
 429     i : Integer;
 430     buf : String;
 431     ret : Boolean;
 432 begin
 433     ret := true;
 434     datstl := TStringList.Create;
 435     try
 436         try
 437             datstl.LoadFromFile(datfilepath);
 438             for i:=0 to datstl.Count -1  do begin
 439                 if AnsiPos(FAbonString, datstl.Strings[i]) = 1 then begin
 440                     buf := datstl.Strings[i];
 441                     Delete(buf,1,Length(FAbonString));
 442                     datstl.Strings[i] := buf;
 443                 end;
 444             end;
 445             datstl.SaveToFile(datfilepath);
 446         except
 447             ret := false;
 448         end;
 449     finally
 450         datstl.Free;
 451     end;
 452     Result := ret;
 453
 454 end;
 455 function TAbon.ReverseExecuteFile(datfilepath : String; resnum : Integer) : Boolean; //DAT\83t\83@\83C\83\8b\82ð\92¼\82É\82¢\82¶\82é
 456 var
 457     datstl : TStringList;
 458     buf : String;
 459     ret : Boolean;
 460 begin
 461     ret := true;
 462     datstl := TStringList.Create;
 463     try
 464         try
 465             datstl.LoadFromFile(datfilepath);
 466             if (resnum > 0) and (resnum <= datstl.Count) then begin
 467                 if AnsiPos(FAbonString, datstl.Strings[resnum-1]) = 1 then begin
 468                     buf := datstl.Strings[resnum-1];
 469                     Delete(buf,1,Length(FAbonString));
 470                     datstl.Strings[resnum-1] := buf;
 471                 end;
 472             end;
 473             datstl.SaveToFile(datfilepath);
 474         except
 475             ret := false;
 476         end;
 477     finally
 478         datstl.Free;
 479     end;
 480     Result := ret;
 481
 482 end;
 483 function TAbon.ReverseExecuteFile(datfilepath : String; firstres : Integer; count : Integer) : Boolean;//DAT\83t\83@\83C\83\8b\82ð\92¼\82É\82¢\82¶\82é
 484 var
 485     datstl : TStringList;
 486     i : Integer;
 487     endnum : Integer; //\8fI\82í\82è\82Ì\83\8c\83X\94Ô
 488     buf : String;
 489     ret : Boolean;
 490 begin
 491     ret := true;
 492     datstl := TStringList.Create;
 493     try
 494         try
 495             datstl.LoadFromFile(datfilepath);
 496             if (firstres > 0) and (firstres <= datstl.Count) then begin
 497                 if firstres + count -1 > datstl.Count then begin
 498                     endnum := datstl.Count;
 499                 end else if count <= 0 then begin
 500                     endnum := firstres + 1;
 501                 end else begin
 502                     endnum := firstres + count -1;
 503                 end;
 504                 for i := firstres to endnum do begin
 505                     if AnsiPos(FAbonString, datstl.Strings[i-1]) = 1 then begin
 506                         buf := datstl.Strings[i-1];
 507                         Delete(buf,1,Length(FAbonString));
 508                         datstl.Strings[i-1] := buf;
 509                     end;
 510                 end;
 511             end;
 512             datstl.SaveToFile(datfilepath);
 513         except
 514             ret := false;
 515         end;
 516     finally
 517         datstl.Free;
 518     end;
 519     Result := ret;
 520 end;
 521 //\8c³\82É\96ß\82·\93z\82ç=================\82±\82±\82Ü\82Å=========================================
 522 //\8c»\8dÝ\83Z\83b\83g\82³\82ê\82Ä\82¢\82éNGword.txt\82ð\8aJ\82
 523 procedure TAbon.EditNGwords();
 524 begin
 525     ShellExecute(0 ,nil,PChar(FNGwordpath),nil,nil,SW_SHOW);
 526 end;
 527 function TAbon.CheckAbonPopupRes(line : String) :Boolean;
 528 var
 529     i : Integer;
 530 begin
 531     if FCutoffNum  = 0 then begin
 532         if AbonPopupRes = true then begin
 533             Result := FindNGwords(line);
 534         end else begin
 535             Result := false;
 536         end;
 537     end else begin
 538         if AbonPopupRes = true then begin
 539             Result := FindNGwords(line);
 540             if Result = false then begin
 541                 for i := 0 to 2 do begin
 542                     Delete(line,1,Ansipos('<>',line)+1);
 543                 end;
 544                 Delete(line,Ansipos('<>',line),Length(line)-Ansipos('<>',line)+1);
 545                 Result := Cutoff(line);
 546             end;
 547         end else begin
 548             Result := false;
 549         end;
 550     end;
 551 end;
 552
 553
 554 end.
 555