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