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