Develop and Download Open Source Software

Browse CVS Repository

Diff of /gikonavigoeson/gikonavi/AbonUnit.pas

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph | View Patch Patch

revision 1.17 by h677, Wed Oct 8 13:21:25 2003 UTC revision 1.17.2.2 by yoffy, Thu Sep 9 16:20:29 2004 UTC
# Line 19  type Line 19  type
19      Ftokens : array of array of string;      Ftokens : array of array of string;
20      FAbonRes : array of TIndiviAbon;      FAbonRes : array of TIndiviAbon;
21      FAbonString : String;      FAbonString : String;
22      FCutoffNum : Integer; //この数以上連続する同じ英字をNGワードとする  //    FCutoffNum : Integer; //この数以上連続する同じ英字をNGワードとする
23      FDeleterlo : Boolean; //&rlo;を削るか //追加&lro;も削る      FDeleterlo : Boolean; //&rlo;を削るか //追加&lro;も削る
24      FReplaceul :Boolean ; //<ul>タグを<br>タグに置換するか      FReplaceul :Boolean ; //<ul>タグを<br>タグに置換するか
25      FReverse : Boolean ;  //NGワードでのあぼ〜んの結果を反転させるか      FReverse : Boolean ;  //NGワードでのあぼ〜んの結果を反転させるか
# Line 30  type Line 30  type
30      FIndividualFileName : String;       //個別あぼ〜んのファイル名      FIndividualFileName : String;       //個別あぼ〜んのファイル名
31      FReturnNGwordLineNum : Boolean;     //NGワードの行数を返す。      FReturnNGwordLineNum : Boolean;     //NGワードの行数を返す。
32      FSetNGResAnchor : Boolean; //NGに該当したときに本文にそのレスへのレスアンカーをつけるかどうか      FSetNGResAnchor : Boolean; //NGに該当したときに本文にそのレスへのレスアンカーをつけるかどうか
33        FDeleteSyria: Boolean;      //シリア語ブラクラ対策(&#1792~&#1871)
34      procedure SetTokens(index: integer ; argline:String);      procedure SetTokens(index: integer ; argline:String);
35      function Getlistpath() : String;      function Getlistpath() : String;
36      procedure Setlistpath(const Value : String);      procedure Setlistpath(const Value : String);
# Line 51  type Line 52  type
52      property NGwordname : String read FNGwordname write FNGwordname;      property NGwordname : String read FNGwordname write FNGwordname;
53          property ReturnNGwordLineNum : Boolean read FReturnNGwordLineNum write FReturnNGwordLineNum default false;          property ReturnNGwordLineNum : Boolean read FReturnNGwordLineNum write FReturnNGwordLineNum default false;
54      property SetNGResAnchor : Boolean read FSetNGResAnchor write FSetNGResAnchor default false;      property SetNGResAnchor : Boolean read FSetNGResAnchor write FSetNGResAnchor default false;
55        property DeleteSyria : Boolean read FDeleteSyria write FDeleteSyria default false;
56      procedure Setroot(root :String);      procedure Setroot(root :String);
57      function Getroot() : String;      function Getroot() : String;
58    
# Line 61  type Line 63  type
63      function ReLoadFromNGwordFile() : Boolean;      function ReLoadFromNGwordFile() : Boolean;
64      procedure LoadFromStringList( bufstl : TStringList );      procedure LoadFromStringList( bufstl : TStringList );
65      function CheckAbonPopupRes(line : String) :Boolean;      function CheckAbonPopupRes(line : String) :Boolean;
66      function FindNGwords(line : String) : Boolean; overload;//1ラインずつ用。          function FindNGwords(const line : String; var NGwordsLineNum : Integer; var Invisible : Boolean) : Boolean;//1ラインずつ用。
67      function FindNGwords(line : String; var NGwordsLineNum : Integer) : Boolean; overload;//1ラインずつ用。          function FindNGwordsEx(const line : String; var NGwordsLineNum : Integer; var Invisible : Boolean) : Boolean;//1ラインずつ用。
68      function Cutoff(line : String) : Boolean; //CutOff値以上個の同じ英数が並んでいたらtrue          //あぼ〜ん処理(NGワードでのフィルタリング)
69      //あぼ〜ん処理(NGワードでのフィルタリング)          procedure Execute(var ThreadStrings : TStringList); overload;
70      procedure Execute(var ThreadStrings : TStringList); overload;          procedure Execute(var ThreadStrings : TStringList; NGwords : TStringList); overload;
71      procedure Execute(var ThreadStrings : TStringList; NGwords : TStringList); overload;          procedure Execute(var ThreadStrings : TStringList; NGwords : TStrings); overload;
72      procedure Execute(var ThreadStrings : TStringList; NGwords : TStrings); overload;          procedure Execute(var ResString : String; ResNumber : Integer); overload;       //主にpluginからのDat To HTML 用
73      //個別あぼ〜んしょり          procedure ExecuteEx(var ThreadStrings : TStringList); overload;
74      procedure IndividualAbon(var ThreadStrings : TStringList; SetResNumFile : String);          procedure ExecuteEx(var ThreadStrings : TStringList; NGwords : TStringList); overload;
75      procedure AddIndividualAbon( ResNum : Integer ; option : Integer);          procedure ExecuteEx(var ThreadStrings : TStringList; NGwords : TStrings); overload;
76      procedure DeleteIndividualAbon( ResNum : Integer);          procedure ExecuteEx(var ResString : String; ResNumber : Integer); overload;     //主にpluginからのDat To HTML 用
77      function GetAbonResCount() : Integer;  
78      function GetAbonResString(Num : Integer) : String;          //個別あぼ〜んしょり
79      function CheckIndividualAbonList(ResNum : Integer) : Boolean;          procedure IndividualAbon(var ThreadStrings : TStringList; SetResNumFile : String); overload;
80      //--          procedure IndividualAbon(var ResString : String; SetResNumFile : String; ResNumber : Integer); overload;
81      function ExecuteFile(datfilepath : String; NGwordpath : String) : Boolean; overload;//DATファイルを直にいじる          procedure AddIndividualAbon( ResNum : Integer ; option : Integer);
82      function ExecuteFile(datfilepath : String; resnum : Integer) : Boolean; overload; //DATファイルを直にいじる          procedure DeleteIndividualAbon( ResNum : Integer);
83      function ExecuteFile(datfilepath : String; firstres : Integer; count : Integer) : Boolean; overload; //DATファイルを直にいじる          function GetAbonResCount() : Integer;
84      function ReverseExecuteFile(datfilepath : String) : Boolean; overload; //DATファイルを直にいじる          function GetAbonResString(Num : Integer) : String;
85      function ReverseExecuteFile(datfilepath : String; resnum : Integer) : Boolean; overload; //DATファイルを直にいじる          function CheckIndividualAbonList(ResNum : Integer) : Boolean;
86      function ReverseExecuteFile(datfilepath : String; firstres : Integer; count : Integer) : Boolean; overload; //DATファイルを直にいじる  
87      //--          procedure EditNGwords();  //NGword.txtを開く。
88      procedure EditNGwords();  //NGword.txtを開く。          function ShowAllTokens() : String;  //デバッグ用
89      function ShowAllTokens() : String;  //デバッグ用          //--
90      //--          procedure GoHome();//Listの1行目を読む
91      procedure GoHome();//Listの1行目を読む          function GoForward() : Boolean; //Listの一つ次のNGワードファイルを読み込む
92      function GoForward() : Boolean; //Listの一つ次のNGワードファイルを読み込む          function GoBack() : Boolean; //Listの一つ前のNGワードファイルを読み込む
93      function GoBack() : Boolean; //Listの一つ前のNGワードファイルを読み込む          //--
94            function TreatSyria(AString: string): string;
95    end;    end;
96  var  var
97      Abon1 :TAbon;          Abon1 :TAbon;
98  const  const
99      NGwordListFileName : String = 'NGwords.list';          NGwordListFileName : String = 'NGwords.list';
100    
101  implementation  implementation
102    
103    uses MojuUtils;
104    
105  constructor TAbon.Create;  constructor TAbon.Create;
106  begin  begin
107      // 初期化          // 初期化
108      FAbonString := '&nbsp;<>&nbsp;<>&nbsp;<>&nbsp;&nbsp;<><>';          FAbonString := '&nbsp;<>&nbsp;<>&nbsp;<>&nbsp;&nbsp;<><>';
109      FCreateNGwordFile := true;          FCreateNGwordFile := true;
110      SetLength(FAbonRes,1);          SetLength(FAbonRes,1);
111      FAbonRes[0].Res := 0;          FAbonRes[0].Res := 0;
112      FAbonRes[0].option := -1;          FAbonRes[0].option := -1;
113    
114  end;  end;
115    
116  destructor TAbon.Destroy;  destructor TAbon.Destroy;
117  begin  begin
118      inherited;          inherited;
119  end;  end;
120  //rootはExe\config\NGwordsフォルダ  //rootはExe\config\NGwordsフォルダ
121  procedure TAbon.Setroot(root :String);  procedure TAbon.Setroot(root :String);
122  var  var
123      bufStringList : TStringList;          bufStringList : TStringList;
124  begin  begin
125      bufStringList := TStringList.Create;          bufStringList := TStringList.Create;
126      try          try
127          if not DirectoryExists(root) then begin                  if not DirectoryExists(root) then begin
128              CreateDir(root);                          CreateDir(root);
129          end;                  end;
130          if root[Length(root)] <> '\' then begin                  if root[Length(root)] <> '\' then begin
131              root := root + '\';                          root := root + '\';
132          end;                  end;
133          Flistpath := root + NGwordListFileName;                  Flistpath := root + NGwordListFileName;
134          LoadListFile(Flistpath, bufStringList);                  LoadListFile(Flistpath, bufStringList);
135      finally          finally
136          bufStringList.Free;                  bufStringList.Free;
137      end;          end;
138      Froot := root;          Froot := root;
139  end;  end;
140  function TAbon.Getroot() : String;  function TAbon.Getroot() : String;
141  begin  begin
142      Result := Froot;          Result := Froot;
143  end;  end;
144  //NGwordpathはNGword.txtのフルパス  //NGwordpathはNGword.txtのフルパス
145  procedure TAbon.SetNGwordpath(path :String);  procedure TAbon.SetNGwordpath(path :String);
146  begin  begin
147      FNGwordpath := Getfullpath(path);          FNGwordpath := Getfullpath(path);
148      LoadFromNGwordFile(FNGwordpath);          LoadFromNGwordFile(FNGwordpath);
149  end;  end;
150  function TAbon.GetNGwordpath() : String;  function TAbon.GetNGwordpath() : String;
151  begin  begin
152      Result :=  FNGwordpath;          Result :=  FNGwordpath;
153  end;  end;
154  //フルパスでなければフルパスにして返す。  //フルパスでなければフルパスにして返す。
155  function TAbon.Getfullpath(argpath : String) : String;  function TAbon.Getfullpath(argpath : String) : String;
156  begin  begin
157      if AnsiPos(':\',argpath) <> 2 then begin  //ドライブからのフルパスが無ければ          if AnsiPos(':\',argpath) <> 2 then begin  //ドライブからのフルパスが無ければ
158          if Getroot() = '' then begin                  if Getroot() = '' then begin
159              Result := '';    //rootパスが設定されてないか空にする                          Result := '';    //rootパスが設定されてないか空にする
160          end else begin                  end else begin
161              if (Froot[Length(Froot)] = '\') and (argpath[1] = '\') then begin  //先頭の\を削除                          if (Froot[Length(Froot)] = '\') and (argpath[1] = '\') then begin  //先頭の\を削除
162                  Delete(argpath,1,1);                                  Delete(argpath,1,1);
163              end;                          end;
164              Insert( Getroot(), argpath , 1);//rootパスを挿入                          Insert( Getroot(), argpath , 1);//rootパスを挿入
165              Result := argpath;                          Result := argpath;
166          end;                  end;
167      end else begin          end else begin
168          Result := argpath;                  Result := argpath;
169      end;          end;
170    
171  end;  end;
172  //NGwordファイルの読み込み  //NGwordファイルの読み込み
173  function TAbon.LoadFromNGwordFile(path :String) : boolean;  function TAbon.LoadFromNGwordFile(path :String) : boolean;
174  var  var
175      bufstl : TStringList;          bufstl : TStringList;
176  begin  begin
177      path := Getfullpath(path);          path := Getfullpath(path);
178      if path = '' then begin          if path = '' then begin
179          Result := false;                  Result := false;
180      end else begin          end else begin
181          bufstl := TStringList.Create;                  bufstl := TStringList.Create;
182          try                  try
183              try                          try
184                  bufstl.LoadFromFile(path);                                  bufstl.LoadFromFile(path);
185                  LoadFromStringList( bufstl );                                  LoadFromStringList( bufstl );
186                  Result := true;                                  Result := true;
187              except                          except
188                  if CreateNGwordFile = true then begin                                  if CreateNGwordFile = true then begin
189                      bufstl.SaveToFile(path);                                          bufstl.SaveToFile(path);
190                  end;                                  end;
191                  Result := false;                                  Result := false;
192              end;                          end;
193          finally                  finally
194              bufstl.Free;                          bufstl.Free;
195          end;                  end;
196      end;          end;
197    
198  end;  end;
199  //NGwordリスト読み込み  //NGwordリスト読み込み
200  procedure TAbon.LoadFromStringList( bufstl : TStringList );  procedure TAbon.LoadFromStringList( bufstl : TStringList );
201  var  var
202      i : integer;          i : integer;
203  begin  begin
204      try          try
205          for i := bufstl.Count -1  downto 0 do begin                  for i := bufstl.Count -1  downto 0 do begin
206              if bufstl.Strings[i] = '' then begin                          if bufstl.Strings[i] = '' then begin
207                  bufstl.Delete(i);                                  bufstl.Delete(i);
208              end;                          end;
209          end;                  end;
210          SetLength(Ftokens,bufstl.Count);                  SetLength(Ftokens,bufstl.Count);
211          for i := 0  to bufstl.Count -1 do begin                  for i := 0  to bufstl.Count -1 do begin
212              SetTokens(i , bufstl.Strings[i]);                          SetTokens(i , bufstl.Strings[i]);
213          end;                  end;
214    
215      except          except
216          Exit;                  Exit;
217      end;          end;
218  end;  end;
219  //NGwordpathが既に設定されているときのリロード用関数  //NGwordpathが既に設定されているときのリロード用関数
220  function TAbon.ReLoadFromNGwordFile() : boolean;  function TAbon.ReLoadFromNGwordFile() : boolean;
221  begin  begin
222      if GetNGwordpath() ='' then begin          if GetNGwordpath() ='' then begin
223          Result := false;                  Result := false;
224      end else begin          end else begin
225          Result := LoadFromNGwordFile( GetNGwordpath() );                  Result := LoadFromNGwordFile( GetNGwordpath() );
226      end;          end;
227  end;  end;
228  function TAbon.Getlistpath() : String;  function TAbon.Getlistpath() : String;
229  begin  begin
230      Result := Flistpath;          Result := Flistpath;
231  end;  end;
232  procedure TAbon.Setlistpath(const Value : String);  procedure TAbon.Setlistpath(const Value : String);
233  begin  begin
234      Flistpath := Getfullpath(Value);          Flistpath := Getfullpath(Value);
235  end;  end;
236  //一行の中のトークンを切り分けてセット  //一行の中のトークンを切り分けてセット
237  procedure TAbon.SetTokens(index: integer ; argline : String);  procedure TAbon.SetTokens(index: integer ; argline : String);
238  var  var
239      ret : Integer;          ret : Integer;
240      bufstl : TStringList;          bufstl : TStringList;
241      i : Integer;          i : Integer;
242      pos : Integer;          pos : Integer;
243      buftoken : String;          buftoken : String;
244  begin  begin
245      pos := 0;          pos := 0;
246      bufstl := TStringList.Create;          bufstl := TStringList.Create;
247      try          try
248          if Length(argline) > 0 then begin                  if Length(argline) > 0 then begin
249                  pos := AnsiPos(#9,argline);                          pos := AnsiPos(#9,argline);
250              while pos <> 0 DO begin                          while pos <> 0 DO begin
251                  buftoken := Copy(argline,1,pos-1);                                  buftoken := Copy(argline,1,pos-1);
252                  Delete(argline,1,pos);                                  Delete(argline,1,pos);
253                  if Length(buftoken) > 0 then begin                                  if Length(buftoken) > 0 then begin
254                                  bufstl.Append(buftoken);                                          bufstl.Append(buftoken);
255                  end;                                  end else if ( bufstl.Count = 0 ) then begin
256                      pos := AnsiPos(#9,argline);                                          bufstl.Append('');
257              end;                                  end;
258                  if Length(argline) > 0 then begin                                  pos := AnsiPos(#9,argline);
259                          bufstl.Append(argline);                          end;
260              end;                          if Length(argline) > 0 then begin
261                  ret := bufstl.Count;                                  bufstl.Append(argline);
262                  SetLength(Ftokens[index],ret);                          end;
263                  for i := 0 to bufstl.Count - 1  do begin                          ret := bufstl.Count;
264                          Ftokens[index][i] := bufstl.Strings[i];                          SetLength(Ftokens[index],ret);
265                  end;                          for i := 0 to bufstl.Count - 1  do begin
266          end;                                  Ftokens[index][i] := bufstl.Strings[i];
267      finally                          end;
268          bufstl.Free;                  end;
269      end;          finally
270                    bufstl.Free;
271            end;
272    
273  end;  end;
274  //Debug用ちゃんとNGワードを拾えているか  //Debug用ちゃんとNGワードを拾えているか
275  function TAbon.ShowAllTokens() : String;  function TAbon.ShowAllTokens() : String;
276  var  var
277      i : Integer;          i : Integer;
278      j : Integer;          j : Integer;
279      ret : String;          ret : String;
280  begin  begin
281      for i := 0 to High(Ftokens) do begin          for i := 0 to High(Ftokens) do begin
282          for j := 0 to High(Ftokens[i]) do begin                  for j := 0 to High(Ftokens[i]) do begin
283              ret := ret + Ftokens[i][j];                          ret := ret + Ftokens[i][j];
284          end;                  end;
285      end;          end;
286      Result := ret;          Result := ret;
287    
288    
289    
290  end;  end;
291    //NGワードが含まれていたらtrueを返し、そのNGワードの行数をNGwordsLineNumに入れて返す。
292  //****************************************************************************//  //もしも透明あぼ〜んにするならInbisibleをtrueにして返す
293  //NGワードが含まれてたらtrueを返す。  function TAbon.FindNGwords(const line : String; var NGwordsLineNum : Integer; var Invisible : Boolean) : Boolean; //1ラインずつ用。
294  function TAbon.FindNGwords(line : String) : Boolean;  var
295  var          lines : Integer;
296      lines : Integer;          cells : Integer;
297      cells : Integer;          hit : Boolean;
298      hit : Boolean;          bufline : String;
299      bufline : String;          start : Integer;
300  begin  begin
301      hit := false;          hit := false;
302      if AnsiPos(FAbonString,line) <> 1 then begin          if AnsiPos(FAbonString,line) <> 1 then begin
303          for lines := 0 to High(Ftokens) do begin                  for lines := 0 to High(Ftokens) do begin
304                  hit := true;                          hit := true;
305              bufline := line;                          bufline := line;
306              for cells := 0 to High(Ftokens[lines]) do begin                          if Ftokens[lines][0] <> ''  then begin
307                  if AnsiPos(Ftokens[lines][cells],bufline) = 0 then begin                                  Invisible := false;
308                          hit := false;                                  start := 0;
309                      break;                          end else begin
310                  end else begin                                  Invisible := true;
311                          Delete(bufline,AnsiPos(Ftokens[lines][cells],bufline),Length(Ftokens[lines][cells]));                                  start := 1;
312                  end;                          end;
313              end;  
314              if hit = true then begin                          for cells := start to High(Ftokens[lines]) do begin
315                  break;                                  if AnsiPos(Ftokens[lines][cells],bufline) = 0 then begin
316              end;                                          hit := false;
317          end;                                          break;
318      end;                                  end else begin
319      Result := hit;                                          Delete(bufline,AnsiPos(Ftokens[lines][cells],bufline),Length(Ftokens[lines][cells]));
320  end;                                  end;
321  //NGワードが含まれていたらtrueを返し、そのNGワードの行数をNGwordsLineNumに入れて返す                          end;
322  function TAbon.FindNGwords(line : String; var NGwordsLineNum : Integer) : Boolean;                          if hit = true then begin
323  var                                  NGwordsLineNum := lines + 1;
324      lines : Integer;                                  break;
325      cells : Integer;                          end;
326      hit : Boolean;                  end;
327      bufline : String;          end;
328  begin          Result := hit;
329      hit := false;  end;
330      if AnsiPos(FAbonString,line) <> 1 then begin  //NGワードが含まれていたらtrueを返し、そのNGワードの行数をNGwordsLineNumに入れて返す。
331          for lines := 0 to High(Ftokens) do begin  //もしも透明あぼ〜んにするならInbisibleをtrueにして返す
332                  hit := true;  //半角全角無視
333              bufline := line;  function TAbon.FindNGwordsEx(const line : String; var NGwordsLineNum : Integer; var Invisible : Boolean) : Boolean;//1ラインずつ用。
334              for cells := 0 to High(Ftokens[lines]) do begin  var
335                  if AnsiPos(Ftokens[lines][cells],bufline) = 0 then begin          lines : Integer;
336                          hit := false;          cells : Integer;
337                      break;          hit : Boolean;
338                  end else begin          bufline : String;
339                          Delete(bufline,AnsiPos(Ftokens[lines][cells],bufline),Length(Ftokens[lines][cells]));          start : Integer;
340                  end;  begin
341              end;          hit := false;
342              if hit = true then begin          if AnsiPos(FAbonString,line) <> 1 then begin
343                  NGwordsLineNum := lines + 1;                  for lines := 0 to High(Ftokens) do begin
344                  break;                          hit := true;
345              end;                          bufline := line;
346          end;                          if Ftokens[lines][0] <> ''  then begin
347      end;                                  Invisible := false;
348      Result := hit;                                  start := 0;
349  end;                          end else begin
350  //CutOff値以上個の同じ英数が並んでいたらtrue                                  Invisible := true;
351  function TAbon.Cutoff(line : String) : Boolean;                                  start := 1;
352  var                          end;
353      i : Integer;  
354      sheed : AnsiChar;                          for cells := start to High(Ftokens[lines]) do begin
355      buf : String;                                  if AnsiPos(Ftokens[lines][cells],bufline) = 0 then begin
356      ret : Bool;                                          hit := false;
357  begin                                          break;
358      ret := false;                                  end else begin
359      if FCutoffNum <> 0 then begin                                          Delete(bufline, AnsiPos(Ftokens[lines][cells],bufline),Length(Ftokens[lines][cells]));
360          for i := 65 to 90 do begin                                  end;
361              sheed := Chr(i);                          end;
362              buf := DupeString(sheed, FCutoffNum);                          if hit = true then begin
363              if AnsiContainsText(line, buf) = true then begin                                  NGwordsLineNum := lines + 1;
364                  ret := true;                                  break;
365                  break;                          end;
366              end;                  end;
367          end;          end;
368      end;          Result := hit;
     Result := ret;  
369  end;  end;
370  //末尾のブール値はtrueだと、NGワードを含むものだけを返す。  //末尾のブール値はtrueだと、NGワードを含むものだけを返す。
371  procedure TAbon.Execute(var ThreadStrings : TStringList);  procedure TAbon.Execute(var ThreadStrings : TStringList);
372  var  var
373      i : Integer;          i : Integer;
374      NGwordsLine : Integer;          NGwordsLine : Integer;
375      bufline : String;          bufline : String;
376  begin          invisi : Boolean;
377      //FRetStrings.Clear;  begin
378      if not ReturnNGwordLineNum then begin          for i:=0 to ThreadStrings.Count - 1 do begin
379      //if ReturnNGwordLineNum then begin                  NGwordsLine := 0;
380          for i:=0 to ThreadStrings.Count - 1 do begin                  if FindNGwords(ThreadStrings.Strings[i], NGwordsLine ,invisi) <> Reverse  then begin
381                  if FindNGwords(ThreadStrings.Strings[i]) <> Reverse  then begin                          if invisi = true then begin
382                  if not SetNGResAnchor then                                  ThreadStrings.Strings[i] := '';
383                          ThreadStrings.Strings[i] := FAbonString                          end else begin
384                  else                                  if not ReturnNGwordLineNum and not SetNGResAnchor then begin
385                          ThreadStrings.Strings[i] := Format('&nbsp;<>&nbsp;<>&nbsp;<>&gt;%d<><>',[(i+1)]);                                          ThreadStrings.Strings[i] := FAbonString;
386                  end else begin                                  end else if not ReturnNGwordLineNum then begin
387                  bufline := ThreadStrings.Strings[i];                                          ThreadStrings.Strings[i] := Format('&nbsp;<>&nbsp;<>&nbsp;<>&gt;%d<><>',[(i+1)]);
388                  if Deleterlo = true then begin                                  end else if not SetNGResAnchor then begin
389                          bufline := AnsiReplaceText( bufline,'&rlo;','' );                                          ThreadStrings.Strings[i] := Format('&nbsp;<>&nbsp;<>&nbsp;<><B> %d 行目のNGワードが含まれています。</B><><>',[NGwordsLine]);
390                      bufline := AnsiReplaceText( bufline,'&lro;','' );                                  end else begin
391                  end;                                          ThreadStrings.Strings[i] := Format('&nbsp;<>&nbsp;<>&nbsp;<><B> %d 行目のNGワードが含まれています。</B>&gt;%d <><>',[NGwordsLine,(i+1)]);
392                  if Replaceul = true then begin                                  end;
393                          bufline := AnsiReplaceText( bufline,'<ul>','<br>' );                          end;
394                          bufline := AnsiReplaceText( bufline,'</ul>','<br>' );                  end else begin
395                  end;                          bufline := ThreadStrings.Strings[i];
396                  ThreadStrings.Strings[i] := bufline;                          if Deleterlo = true then begin
397                  end;                                  bufline := CustomStringReplace(bufline,'&rlo;','');
398          end;                                  bufline := CustomStringReplace(bufline,'&lro;','');
399      end else begin                          end;
400          for i:=0 to ThreadStrings.Count - 1 do begin                          if Replaceul = true then begin
401              NGwordsLine := 0;                                  bufline := CustomStringReplace( bufline,'<ul>','<br>' );
402                  if FindNGwords(ThreadStrings.Strings[i], NGwordsLine) <> Reverse  then begin                                  bufline := CustomStringReplace( bufline,'</ul>','<br>' );
403                  if not SetNGResAnchor then                          end;
404                      ThreadStrings.Strings[i] := Format('&nbsp;<>&nbsp;<>&nbsp;<><B> %d 行目のNGワードが含まれています。</B><><>',[NGwordsLine])                          if DeleteSyria = true then
405                  else                                  bufline := TreatSyria(bufline);
406                          ThreadStrings.Strings[i] := Format('&nbsp;<>&nbsp;<>&nbsp;<><B> %d 行目のNGワードが含まれています。</B>&gt;%d <><>',[NGwordsLine,(i+1)]);                          ThreadStrings.Strings[i] := bufline;
407                  end else begin                  end;
408                  bufline := ThreadStrings.Strings[i];          end;
409                  if Deleterlo = true then begin  end;
410                          bufline := AnsiReplaceText( bufline,'&rlo;','' );  procedure TAbon.Execute(var ResString : String; ResNumber : Integer);
411                      bufline := AnsiReplaceText( bufline,'&lro;','' );  var
412                  end;          NGwordsLine : Integer;
413                  if Replaceul = true then begin          bufline : String;
414                          bufline := AnsiReplaceText( bufline,'<ul>','<br>' );          invisi : Boolean;
415                          bufline := AnsiReplaceText( bufline,'</ul>','<br>' );  begin
416                  end;          NGwordsLine := 0;
417                  ThreadStrings.Strings[i] := bufline;          if FindNGwords(ResString, NGwordsLine ,invisi) <> Reverse  then begin
418                  end;                  if invisi = true then begin
419          end;                          ResString := '';
420                    end else begin
421      end;                          if not ReturnNGwordLineNum and not SetNGResAnchor then begin
422                                    ResString := FAbonString;
423                            end else if not ReturnNGwordLineNum then begin
424                                    ResString := Format('&nbsp;<>&nbsp;<>&nbsp;<>&gt;%d<><>',[(ResNumber)]);
425                            end else if not SetNGResAnchor then begin
426                                    ResString := Format('&nbsp;<>&nbsp;<>&nbsp;<><B> %d 行目のNGワードが含まれています。</B><><>',[NGwordsLine]);
427                            end else begin
428                                    ResString := Format('&nbsp;<>&nbsp;<>&nbsp;<><B> %d 行目のNGワードが含まれています。</B>&gt;%d <><>',[NGwordsLine,(ResNumber)]);
429                            end;
430                    end;
431            end else begin
432                    bufline := ResString;
433                    if Deleterlo = true then begin
434                            bufline := CustomStringReplace( bufline,'&rlo;','' );
435                            bufline := CustomStringReplace( bufline,'&lro;','' );
436                    end;
437                    if Replaceul = true then begin
438                            bufline := CustomStringReplace( bufline,'<ul>','<br>' );
439                            bufline := CustomStringReplace( bufline,'</ul>','<br>' );
440                    end;
441                    if DeleteSyria = true then
442                            bufline := TreatSyria(bufline);
443                    ResString := bufline;
444            end;
445  end;  end;
446    
447  procedure TAbon.Execute(var ThreadStrings : TStringList; NGwords : TStringList);  procedure TAbon.Execute(var ThreadStrings : TStringList; NGwords : TStringList);
448  var  var
449      i : Integer;          i : Integer;
450  begin  begin
451      SetLength(Ftokens,NGwords.Count);          SetLength(Ftokens,NGwords.Count);
452      for i := 0  to NGwords.Count -1 do begin          for i := 0  to NGwords.Count -1 do begin
453          SetTokens(i , NGwords.Strings[i]);                  SetTokens(i , NGwords.Strings[i]);
454      end;          end;
455      Execute(ThreadStrings);          Execute(ThreadStrings);
456    
457  end;  end;
458  procedure TAbon.Execute(var ThreadStrings : TStringList; NGwords : TStrings);  procedure TAbon.Execute(var ThreadStrings : TStringList; NGwords : TStrings);
459  var  var
460      i : Integer;          i : Integer;
461      buf : TStringList;          buf : TStringList;
462  begin  begin
463      buf := TStringList.Create;          buf := TStringList.Create;
464      buf.AddStrings(NGwords);          buf.AddStrings(NGwords);
465      SetLength(Ftokens,buf.Count);          SetLength(Ftokens,buf.Count);
466      for i := 0  to buf.Count -1 do begin          for i := 0  to buf.Count -1 do begin
467          SetTokens(i , buf.Strings[i]);                  SetTokens(i , buf.Strings[i]);
468      end;          end;
469      Execute(ThreadStrings);          Execute(ThreadStrings);
470      buf.Free;          buf.Free;
471  end;  end;
472    
473    //末尾のブール値はtrueだと、NGワードを含むものだけを返す。
474  //****************************************************************************//  procedure TAbon.ExecuteEx(var ThreadStrings : TStringList);
 //DATを直にいじる奴ら===========================================================  
 //NGワードを含むレスの先頭にあぼーんを挿入  
 function TAbon.ExecuteFile(datfilepath : String; NGwordpath : String) : Boolean; //DATファイルを直にいじる  
 var  
     datstl : TStringList;  
     ret : Boolean;  
     i : Integer;  
 begin  
     datstl := TStringList.Create;  
     ret := true;  
     try  
         try  
             datstl.LoadFromFile(datfilepath);  
             for i := 0 to datstl.Count -1 do begin  
                 if FindNGwords(datstl.Strings[i]) = true  then begin  
                     datstl.Strings[i] := FAbonString + datstl.Strings[i]  
                 end;  
             end;  
   
             datstl.SaveToFile(datfilepath);  
         except  
             ret := false;  
         end;  
     finally  
         datstl.Free;  
     end;  
     Result := ret;  
   
 end;  
 //指定されたレス番の先頭にあぼーん挿入  
 function TAbon.ExecuteFile(datfilepath : String; resnum : Integer) : Boolean; //DATファイルを直にいじる  
 var  
     datstl : TStringList;  
     ret : Boolean;  
 begin  
     ret := true;  
     datstl := TStringList.Create;  
     try  
         try  
             datstl.LoadFromFile(datfilepath);  
             if (resnum > 0) and (resnum <= datstl.Count) then begin  
                 if AnsiPos(FAbonString, datstl.Strings[resnum-1]) <> 1 then begin  
                     datstl.Strings[resnum-1] := FAbonString + datstl.Strings[resnum-1];  
                 end;  
             end;  
             datstl.SaveToFile(datfilepath);  
         except  
             ret := false;  
         end;  
     finally  
         datstl.Free;  
     end;  
     Result := ret;  
 end;  
 //firstresからcount個のレスの先頭にあぼーん挿入  
 function TAbon.ExecuteFile(datfilepath : String; firstres : Integer; count : Integer) : Boolean; //DATファイルを直にいじる  
475  var  var
476      datstl : TStringList;          i : Integer;
477      i : Integer;          NGwordsLine : Integer;
478      endnum : Integer; //終わりのレス番          bufline : String;
479      ret : Boolean;          invisi : Boolean;
480  begin  begin
481      ret := true;          for i:=0 to ThreadStrings.Count - 1 do begin
482      datstl := TStringList.Create;                  NGwordsLine := 0;
483      try                  if FindNGwordsEx(ThreadStrings.Strings[i], NGwordsLine ,invisi) <> Reverse  then begin
484          try                          if invisi = true then begin
485              datstl.LoadFromFile(datfilepath);                                  ThreadStrings.Strings[i] := '';
486              if (firstres > 0) and (firstres <= datstl.Count) then begin                          end else begin
487                  if firstres + count -1 > datstl.Count then begin                                  if not ReturnNGwordLineNum and not SetNGResAnchor then begin
488                      endnum := datstl.Count;                                          ThreadStrings.Strings[i] := FAbonString;
489                  end else if count <= 0 then begin                                  end else if not ReturnNGwordLineNum then begin
490                      endnum := firstres + 1;                                          ThreadStrings.Strings[i] := Format('&nbsp;<>&nbsp;<>&nbsp;<>&gt;%d<><>',[(i+1)]);
491                  end else begin                                  end else if not SetNGResAnchor then begin
492                      endnum := firstres + count -1;                                          ThreadStrings.Strings[i] := Format('&nbsp;<>&nbsp;<>&nbsp;<><B> %d 行目のNGワードが含まれています。</B><><>',[NGwordsLine]);
493                  end;                                  end else begin
494                                            ThreadStrings.Strings[i] := Format('&nbsp;<>&nbsp;<>&nbsp;<><B> %d 行目のNGワードが含まれています。</B>&gt;%d <><>',[NGwordsLine,(i+1)]);
495                  for i := firstres to endnum do begin                                  end;
496                      if AnsiPos(FAbonString, datstl.Strings[i-1]) <> 1 then begin                          end;
497                          datstl.Strings[i-1] := FAbonString + datstl.Strings[i-1];                  end else begin
498                      end;                          bufline := ThreadStrings.Strings[i];
499                  end;                          if Deleterlo = true then begin
500              end;                                  bufline := CustomStringReplace(bufline,'&rlo;','');
501              datstl.SaveToFile(datfilepath);                                  bufline := CustomStringReplace(bufline,'&lro;','');
502          except                          end;
503              ret := false;                          if Replaceul = true then begin
504          end;                                  bufline := CustomStringReplace( bufline,'<ul>','<br>' );
505      finally                                  bufline := CustomStringReplace( bufline,'</ul>','<br>' );
506          datstl.Free;                          end;
507      end;                          if DeleteSyria = true then
508      Result := ret;                                  bufline := TreatSyria(bufline);
509                            ThreadStrings.Strings[i] := bufline;
510                    end;
511            end;
512    end;
513    procedure TAbon.ExecuteEx(var ResString : String; ResNumber : Integer);
514    var
515            NGwordsLine : Integer;
516            bufline : String;
517            invisi : Boolean;
518    begin
519            NGwordsLine := 0;
520            if FindNGwordsEx(ResString, NGwordsLine ,invisi) <> Reverse  then begin
521                    if invisi = true then begin
522                            ResString := '';
523                    end else begin
524                            if not ReturnNGwordLineNum and not SetNGResAnchor then begin
525                                    ResString := FAbonString;
526                            end else if not ReturnNGwordLineNum then begin
527                                    ResString := Format('&nbsp;<>&nbsp;<>&nbsp;<>&gt;%d<><>',[(ResNumber)]);
528                            end else if not SetNGResAnchor then begin
529                                    ResString := Format('&nbsp;<>&nbsp;<>&nbsp;<><B> %d 行目のNGワードが含まれています。</B><><>',[NGwordsLine]);
530                            end else begin
531                                    ResString := Format('&nbsp;<>&nbsp;<>&nbsp;<><B> %d 行目のNGワードが含まれています。</B>&gt;%d <><>',[NGwordsLine,(ResNumber)]);
532                            end;
533                    end;
534            end else begin
535                    bufline := ResString;
536                    if Deleterlo = true then begin
537                            bufline := CustomStringReplace( bufline,'&rlo;','' );
538                            bufline := CustomStringReplace( bufline,'&lro;','' );
539                    end;
540                    if Replaceul = true then begin
541                            bufline := CustomStringReplace( bufline,'<ul>','<br>' );
542                            bufline := CustomStringReplace( bufline,'</ul>','<br>' );
543                    end;
544                    if DeleteSyria = true then
545                            bufline := TreatSyria(bufline);
546                    ResString := bufline;
547            end;
548  end;  end;
 //DATを直にいじる奴ら==========ここまで=========================================  
549    
550  //元に戻す奴ら==================================================================  procedure TAbon.ExecuteEx(var ThreadStrings : TStringList; NGwords : TStringList);
 function TAbon.ReverseExecuteFile(datfilepath : String) : Boolean; //DATファイルを直にいじる  
551  var  var
552      datstl : TStringList;          i : Integer;
     i : Integer;  
     buf : String;  
     ret : Boolean;  
 begin  
     ret := true;  
     datstl := TStringList.Create;  
     try  
         try  
             datstl.LoadFromFile(datfilepath);  
             for i:=0 to datstl.Count -1  do begin  
                 if AnsiPos(FAbonString, datstl.Strings[i]) = 1 then begin  
                     buf := datstl.Strings[i];  
                     Delete(buf,1,Length(FAbonString));  
                     datstl.Strings[i] := buf;  
                 end;  
             end;  
             datstl.SaveToFile(datfilepath);  
         except  
             ret := false;  
         end;  
     finally  
         datstl.Free;  
     end;  
     Result := ret;  
   
 end;  
 function TAbon.ReverseExecuteFile(datfilepath : String; resnum : Integer) : Boolean; //DATファイルを直にいじる  
 var  
     datstl : TStringList;  
     buf : String;  
     ret : Boolean;  
553  begin  begin
554      ret := true;          SetLength(Ftokens,NGwords.Count);
555      datstl := TStringList.Create;          for i := 0  to NGwords.Count -1 do begin
556      try                  SetTokens(i , NGwords.Strings[i]);
557          try          end;
558              datstl.LoadFromFile(datfilepath);          ExecuteEx(ThreadStrings);
             if (resnum > 0) and (resnum <= datstl.Count) then begin  
                 if AnsiPos(FAbonString, datstl.Strings[resnum-1]) = 1 then begin  
                     buf := datstl.Strings[resnum-1];  
                     Delete(buf,1,Length(FAbonString));  
                     datstl.Strings[resnum-1] := buf;  
                 end;  
             end;  
             datstl.SaveToFile(datfilepath);  
         except  
             ret := false;  
         end;  
     finally  
         datstl.Free;  
     end;  
     Result := ret;  
559    
560  end;  end;
561  function TAbon.ReverseExecuteFile(datfilepath : String; firstres : Integer; count : Integer) : Boolean;//DATファイルを直にいじる  procedure TAbon.ExecuteEx(var ThreadStrings : TStringList; NGwords : TStrings);
562  var  var
563      datstl : TStringList;          i : Integer;
564      i : Integer;          buf : TStringList;
     endnum : Integer; //終わりのレス番  
     buf : String;  
     ret : Boolean;  
565  begin  begin
566      ret := true;          buf := TStringList.Create;
567      datstl := TStringList.Create;          buf.AddStrings(NGwords);
568      try          SetLength(Ftokens,buf.Count);
569          try          for i := 0  to buf.Count -1 do begin
570              datstl.LoadFromFile(datfilepath);                  SetTokens(i , buf.Strings[i]);
571              if (firstres > 0) and (firstres <= datstl.Count) then begin          end;
572                  if firstres + count -1 > datstl.Count then begin          ExecuteEx(ThreadStrings);
573                      endnum := datstl.Count;          buf.Free;
                 end else if count <= 0 then begin  
                     endnum := firstres + 1;  
                 end else begin  
                     endnum := firstres + count -1;  
                 end;  
                 for i := firstres to endnum do begin  
                     if AnsiPos(FAbonString, datstl.Strings[i-1]) = 1 then begin  
                         buf := datstl.Strings[i-1];  
                         Delete(buf,1,Length(FAbonString));  
                         datstl.Strings[i-1] := buf;  
                     end;  
                 end;  
             end;  
             datstl.SaveToFile(datfilepath);  
         except  
             ret := false;  
         end;  
     finally  
         datstl.Free;  
     end;  
     Result := ret;  
574  end;  end;
575  //元に戻す奴ら=================ここまで=========================================  
576    //****************************************************************************//
577  //現在セットされているNGword.txtを開く  //現在セットされているNGword.txtを開く
578  procedure TAbon.EditNGwords();  procedure TAbon.EditNGwords();
579  begin  begin
580      ShellExecute(0 ,nil,PChar(FNGwordpath),nil,nil,SW_SHOW);          ShellExecute(0 ,nil,PChar(FNGwordpath),nil,nil,SW_SHOW);
581  end;  end;
582  //ポップアップ用判定関数  //ポップアップ用判定関数
583  function TAbon.CheckAbonPopupRes(line : String) :Boolean;  function TAbon.CheckAbonPopupRes(line : String) :Boolean;
584    var
585            i: Integer;
586            v: boolean;
587  begin  begin
588      if AbonPopupRes = true then begin          if AbonPopupRes = true then begin
589          Result := FindNGwords(line);                  Result := FindNGwords(line, i ,v);
590      end else begin          end else begin
591          Result := false;                  Result := false;
592      end;          end;
593  end;  end;
594  //複数のNGワードテキストを読み込む==============================================  //複数のNGワードテキストを読み込む==============================================
595  //Listファイルを読み込む  //Listファイルを読み込む
# Line 733  begin Line 677  begin
677          FAbonRes[0].option := -1;          FAbonRes[0].option := -1;
678      end;      end;
679  end;  end;
680    procedure TAbon.IndividualAbon(var ResString : String; SetResNumFile : String; ResNumber : Integer);
681    var
682            i : Integer;
683    begin
684            if FileExists(SetResNumFile) = true then begin
685            if LoadFromSetResNumFile(SetResNumFile) = true then begin
686                    for i := 0 to High(FAbonRes) do begin
687                     if FAbonRes[i].Res = ResNumber then begin
688                            if FAbonRes[i].option = 0 then begin
689                            ResString := '';
690                        end else begin
691                            ResString := 'あぼ〜ん<>あぼ〜ん<>あぼ〜ん<>あぼ〜ん<>';
692                        end;
693                        Exit;
694                     end;
695                end;
696            end;
697        end else begin
698            FIndividualFileName := SetResNumFile;
699            SetLength(FAbonRes,1);
700            FAbonRes[0].Res := 0;
701            FAbonRes[0].option := -1;
702        end;
703    end;
704    
705  //個別あぼ〜んファイル読み込み関数  //個別あぼ〜んファイル読み込み関数
706  function TAbon.LoadFromSetResNumFile(SetResNumFile : String) : Boolean;  function TAbon.LoadFromSetResNumFile(SetResNumFile : String) : Boolean;
707  var  var
# Line 856  begin Line 825  begin
825          end;          end;
826      end;      end;
827      Result := false;      Result := false;
828        
829    end;
830    //シリア語ブラクラ対策
831    function TAbon.TreatSyria(AString: string): string;
832    var
833            //count: Integer; //(&#1792~&#1871)
834        pos: Integer;
835        tmp: string;
836    begin
837        pos := AnsiPos('&#18', AString);
838            while pos <> 0  do begin
839            if AString[pos+6] = ';' then begin
840                if StrToIntDef(Copy(AString, pos+4, 2), 0) <= 71 then begin
841                        tmp := tmp + Copy(AString, 1, pos - 1);
842                    Delete(AString, 1, pos+6);
843                end else begin
844                        tmp := tmp + Copy(AString, 1, pos + 6);
845                    Delete(AString, 1, pos+6);
846                end;
847            end else begin
848                tmp := tmp + Copy(AString, 1, pos + 3);
849                    Delete(AString, 1, pos+3);
850            end;
851            pos := AnsiPos('&#18', AString);
852        end;
853        if Length(AString) > 0 then
854            tmp := tmp + AString;
855        AString := tmp;
856        tmp := '';
857    
858        pos := AnsiPos('&#179', AString);
859            while pos <> 0 do begin
860            if AString[pos+6] = ';' then begin
861                if StrToIntDef(Copy(AString, pos+5, 1), 0) > 2 then begin
862                        tmp := tmp + Copy(AString, 1, pos - 1);
863                    Delete(AString, 1, pos+6);
864                end else begin
865                        tmp := tmp + Copy(AString, 1, pos + 6);
866                    Delete(AString, 1, pos+6);
867                end;
868                tmp := tmp + Copy(AString, 1, pos - 1);
869                    Delete(AString, 1, pos+6);
870            end else begin
871                tmp := tmp + Copy(AString, 1, pos + 4);
872                    Delete(AString, 1, pos+4);
873            end;
874            pos := AnsiPos('&#179', AString);
875        end;
876        if Length(AString) > 0 then
877            tmp := tmp + AString;
878        Result := tmp;
879  end;  end;
880  end.  end.
881    

Legend:
Removed from v.1.17  
changed lines
  Added in v.1.17.2.2

Back to OSDN">Back to OSDN
ViewVC Help
Powered by ViewVC 1.1.26