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.1 by h677, Tue Aug 12 07:58:32 2003 UTC revision 1.2 by h677, Tue Aug 12 14:13:53 2003 UTC
# Line 2  unit AbonUnit; Line 2  unit AbonUnit;
2    
3  interface  interface
4  uses  uses
5      Windows,Messages, SysUtils, Classes,StdCtrls, ShellAPI;      Windows,Messages, ShellAPI, SysUtils, Classes,StdCtrls,StrUtils;
6    
7  type  type
8    TAbon = class(TObject)    TAbon = class(TObject)
# Line 10  type Line 10  type
10      { Private 宣言 }      { Private 宣言 }
11      Froot : String;      Froot : String;
12      FNGwordpath : String;      FNGwordpath : String;
13      tokens : array of array of string;      Ftokens : array of array of string;
14      FAbonString : String;      FAbonString : String;
15      RetStrings : TStringList;      FRetStrings : TStringList;
16        FCutoffNum : Integer; //この数以上連続する同じ英字をNGワードとする
17      procedure SetTokens(index: integer ; argline:String);      procedure SetTokens(index: integer ; argline:String);
18    
19    public    public
# Line 24  type Line 25  type
25      function Getroot() : String;      function Getroot() : String;
26      procedure SetNGwordpath(path :String);      procedure SetNGwordpath(path :String);
27      function GetNGwordpath() : String;      function GetNGwordpath() : String;
28        procedure SetCutoffNum(value : Integer);
29        function GetCutoffNum() : Integer;
30      function LoadFromNGwordFile(path :String) : Boolean;      function LoadFromNGwordFile(path :String) : Boolean;
31      function ReLoadFromNGwordFile() : Boolean;      function ReLoadFromNGwordFile() : Boolean;
32      function FindNGwords(line : String) : Boolean; //1ラインずつ用。      function FindNGwords(line : String) : Boolean; //1ラインずつ用。
33      //末尾のブール値はtrueだと、NGワードを含むものだけを返す。      function Cutoff(line : String) : String; //CutOff値以上個の同じ英数が並んでいたらtrue
34      function Execute(DestStrings : TStringList; reverse : Boolean) : TStringList; overload;      //あぼ〜んの時についでに&rlo;をさくる、<ul>タグを<br>タグに置換するか、末尾のブール値はtrueだと、NGワードを含むものだけを返す。
35      function Execute(DestStrings : TStringList; NGwords : TStringList ; reverse : Boolean) : TStringList; overload;      function Execute(DestStrings : TStringList; deleterlo : Boolean; replaceul :Boolean ; reverse : Boolean) : TStringList; overload;
36      function Execute(DestStrings : TStringList; NGwords : TStrings ; reverse : Boolean) : TStringList; overload;      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ファイルを直にいじる      function ExecuteFile(datfilepath : String; NGwordpath : String) : Boolean; overload;//DATファイルを直にいじる
40      function ExecuteFile(datfilepath : String; resnum : Integer) : Boolean; overload; //DATファイルを直にいじる      function ExecuteFile(datfilepath : String; resnum : Integer) : Boolean; overload; //DATファイルを直にいじる
# Line 47  var Line 51  var
51    
52  implementation  implementation
53    
   
54  constructor TAbon.Create;  constructor TAbon.Create;
55  begin  begin
56      // 初期化      // 初期化
57      FAbonString := '&nbsp;<>&nbsp;<>&nbsp;<>&nbsp;&nbsp;<><>';      FAbonString := '&nbsp;<>&nbsp;<>&nbsp;<>&nbsp;&nbsp;<><>';
58      RetStrings := TStringList.Create;      FRetStrings := TStringList.Create;
59        SetCutoffNum(0);
60  end;  end;
61    
62  destructor TAbon.Destroy;  destructor TAbon.Destroy;
63  begin  begin
64      RetStrings.Free;      FRetStrings.Free;
65      inherited;      inherited;
66  end;  end;
67    
# Line 102  begin Line 106  begin
106      bufstl := TStringList.Create;      bufstl := TStringList.Create;
107      try      try
108          bufstl.LoadFromFile(path);          bufstl.LoadFromFile(path);
109          SetLength(tokens,bufstl.Count);          SetLength(Ftokens,bufstl.Count);
110          for i := 0  to bufstl.Count -1 do begin          for i := 0  to bufstl.Count -1 do begin
111              SetTokens(i , bufstl.Strings[i]);              SetTokens(i , bufstl.Strings[i]);
112          end;          end;
113    
114      except      except
         bufstl.SaveToFile(path);  
115          bufstl.Free;          bufstl.Free;
116          Result := false;          Result := false;
117          Exit;          Exit;
# Line 137  begin Line 140  begin
140      bufstl.Delimiter := #9;  //区切り子を’タブ’に設定      bufstl.Delimiter := #9;  //区切り子を’タブ’に設定
141      bufstl.DelimitedText := argline;      bufstl.DelimitedText := argline;
142      ret := bufstl.Count;      ret := bufstl.Count;
143      SetLength(tokens[index],ret);      SetLength(Ftokens[index],ret);
144      for i := 0 to bufstl.Count - 1  do begin      for i := 0 to bufstl.Count - 1  do begin
145          tokens[index][i] := bufstl.Strings[i];          Ftokens[index][i] := bufstl.Strings[i];
146      end;      end;
147      bufstl.Free;      bufstl.Free;
148    
149  end;  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;  function TAbon.ShowAllTokens() : String;
163  var  var
164      i : Integer;      i : Integer;
165      j : Integer;      j : Integer;
166      ret : String;      ret : String;
167  begin  begin
168      for i := 0 to High(tokens) do begin      for i := 0 to High(Ftokens) do begin
169          for j := 0 to High(tokens[i]) do begin          for j := 0 to High(Ftokens[i]) do begin
170              ret := ret + tokens[i][j];              ret := ret + Ftokens[i][j];
171          end;          end;
172      end;      end;
173      Result := ret;      Result := ret;
# Line 171  var Line 186  var
186  begin  begin
187      hit := false;      hit := false;
188      if AnsiPos(FAbonString,line) <> 1 then begin      if AnsiPos(FAbonString,line) <> 1 then begin
189          for i := 0 to High(tokens) do begin          for i := 0 to High(Ftokens) do begin
190              hit := true;              hit := true;
191              for j := 0 to High(tokens[i]) do begin              for j := 0 to High(Ftokens[i]) do begin
192                  if AnsiPos(tokens[i][j],line) = 0 then begin                  if AnsiPos(Ftokens[i][j],line) = 0 then begin
193                      hit := false;                      hit := false;
194                      break;                      break;
195                  end;                  end;
# Line 187  begin Line 202  begin
202      Result := hit;      Result := hit;
203    
204  end;  end;
205    //CutOff値以上個の同じ英数が並んでいたらあぼ〜ん
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  //末尾のブール値はtrueだと、NGワードを含むものだけを返す。  //末尾のブール値はtrueだと、NGワードを含むものだけを返す。
227  function TAbon.Execute(DestStrings : TStringList; reverse : Boolean) : TStringList;  function TAbon.Execute(DestStrings : TStringList; deleterlo : Boolean; replaceul :Boolean ;reverse : Boolean) : TStringList;
228  var  var
229      i : Integer;      i : Integer;
230        bufline : String;
231  begin  begin
232      RetStrings.Clear;      FRetStrings.Clear;
233    
234      if reverse = false then begin      if reverse = false then begin
235          for i:=0 to DestStrings.Count - 1 do begin          for i:=0 to DestStrings.Count - 1 do begin
236              if FindNGwords(DestStrings.Strings[i]) = true then begin              if FindNGwords(DestStrings.Strings[i]) = true  then begin
237                  RetStrings.Append(FAbonString);                  FRetStrings.Append(FAbonString);
238              end else begin              end else begin
239                  RetStrings.Append(DestStrings.Strings[i]);                  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;              end;
249          end;          end;
250      end else begin      end else begin
251          for i:=0 to DestStrings.Count - 1 do begin          for i:=0 to DestStrings.Count - 1 do begin
252              if FindNGwords(DestStrings.Strings[i]) = false then begin              if FindNGwords(DestStrings.Strings[i]) = false then begin
253                  RetStrings.Append(FAbonString);                  FRetStrings.Append(FAbonString);
254              end else begin              end else begin
255                  RetStrings.Append(DestStrings.Strings[i]);                  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;              end;
267          end;          end;
268    
269      end;      end;
270      Result := RetStrings;      Result := FRetStrings;
271    
272  end;  end;
273  function TAbon.Execute(DestStrings : TStringList; NGwords : TStringList ; reverse : Boolean) : TStringList;  function TAbon.Execute(DestStrings : TStringList; NGwords : TStringList ; deleterlo : Boolean; replaceul :Boolean ; reverse : Boolean) : TStringList;
274  var  var
275      i : Integer;      i : Integer;
276  begin  begin
277      SetLength(tokens,NGwords.Count);      SetLength(Ftokens,NGwords.Count);
278      for i := 0  to NGwords.Count -1 do begin      for i := 0  to NGwords.Count -1 do begin
279          SetTokens(i , NGwords.Strings[i]);          SetTokens(i , NGwords.Strings[i]);
280      end;      end;
281      Result := Execute(DestStrings,reverse);      Result := Execute(DestStrings,deleterlo,replaceul,reverse);
282    
283  end;  end;
284  function TAbon.Execute(DestStrings : TStringList; NGwords : TStrings ; reverse : Boolean) : TStringList;  function TAbon.Execute(DestStrings : TStringList; NGwords : TStrings ; deleterlo : Boolean; replaceul :Boolean ;reverse : Boolean) : TStringList;
285  var  var
286      i : Integer;      i : Integer;
287      buf : TStringList;      buf : TStringList;
288  begin  begin
289      buf := TStringList.Create;      buf := TStringList.Create;
290      buf.AddStrings(NGwords);      buf.AddStrings(NGwords);
291      SetLength(tokens,buf.Count);      SetLength(Ftokens,buf.Count);
292      for i := 0  to buf.Count -1 do begin      for i := 0  to buf.Count -1 do begin
293          SetTokens(i , buf.Strings[i]);          SetTokens(i , buf.Strings[i]);
294      end;      end;
295      Result := Execute(DestStrings,reverse);      Result := Execute(DestStrings,deleterlo,replaceul,reverse);
296      buf.Free;      buf.Free;
297  end;  end;
298    

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2

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