Develop and Download Open Source Software

Browse CVS Repository

Annotation of /gikonavigoeson/gikonavi/AbonUnit.pas

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


Revision 1.4 - (hide annotations) (download) (as text)
Wed Aug 13 05:16:07 2003 UTC (20 years, 8 months ago) by h677
Branch: MAIN
Changes since 1.3: +3 -2 lines
File MIME type: text/x-pascal
NGword.txtĤʤäȤ˼ư褦ˤ

1 h677 1.1 unit AbonUnit;
2    
3     interface
4     uses
5 h677 1.2 Windows,Messages, ShellAPI, SysUtils, Classes,StdCtrls,StrUtils;
6 h677 1.1
7     type
8     TAbon = class(TObject)
9     private
10     { Private 宣言 }
11     Froot : String;
12     FNGwordpath : String;
13 h677 1.2 Ftokens : array of array of string;
14 h677 1.1 FAbonString : String;
15 h677 1.2 FRetStrings : TStringList;
16     FCutoffNum : Integer; //この数以上連続する同じ英字をNGワードとする
17 h677 1.3 FDeleterlo : Boolean; //&rlo;を削るか
18     FReplaceul :Boolean ; //<ul>タグを<br>タグに置換するか
19     FReverse : Boolean ; //NGワードでのあぼ〜んの結果を反転させるか
20     FAbonPopupRes : Boolean; //レスポップアップの時にあぼーんするか
21     FCreateNGwordFile : Boolean; //指定されたpathにNGワードtxtが無かったときに自動的に生成するか
22 h677 1.1 procedure SetTokens(index: integer ; argline:String);
23    
24     public
25     { Public 宣言 }
26     constructor Create; // コンストラクタ
27     destructor Destroy; override; // デストラクタ
28 h677 1.3 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 h677 1.4 property CreateNGwordFile: Boolean read FCreateNGwordFile write FCreateNGwordFile;
32 h677 1.3 property AbonString : String read FAbonString write FAbonString;
33     property AbonPopupRes : Boolean read FAbonPopupRes write FAbonPopupRes default false;
34 h677 1.1 procedure Setroot(root :String);
35     function Getroot() : String;
36     procedure SetNGwordpath(path :String);
37     function GetNGwordpath() : String;
38 h677 1.2 procedure SetCutoffNum(value : Integer);
39     function GetCutoffNum() : Integer;
40 h677 1.1 function LoadFromNGwordFile(path :String) : Boolean;
41     function ReLoadFromNGwordFile() : Boolean;
42 h677 1.3 function CheckAbonPopupRes(line : String) :Boolean;
43 h677 1.1 function FindNGwords(line : String) : Boolean; //1ラインずつ用。
44 h677 1.3 function Cutoff(line : String) : Boolean; //CutOff値以上個の同じ英数が並んでいたらtrue
45     //あぼ〜ん処理
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 h677 1.1 //--
50     function ExecuteFile(datfilepath : String; NGwordpath : String) : Boolean; overload;//DATファイルを直にいじる
51     function ExecuteFile(datfilepath : String; resnum : Integer) : Boolean; overload; //DATファイルを直にいじる
52     function ExecuteFile(datfilepath : String; firstres : Integer; count : Integer) : Boolean; overload; //DATファイルを直にいじる
53     function ReverseExecuteFile(datfilepath : String) : Boolean; overload; //DATファイルを直にいじる
54     function ReverseExecuteFile(datfilepath : String; resnum : Integer) : Boolean; overload; //DATファイルを直にいじる
55     function ReverseExecuteFile(datfilepath : String; firstres : Integer; count : Integer) : Boolean; overload; //DATファイルを直にいじる
56     //--
57     procedure EditNGwords(); //NGword.txtを開く。
58     function ShowAllTokens() : String; //デバッグ用
59     end;
60     var
61     Abon1 :TAbon;
62    
63     implementation
64    
65     constructor TAbon.Create;
66     begin
67     // 初期化
68     FAbonString := '&nbsp;<>&nbsp;<>&nbsp;<>&nbsp;&nbsp;<><>';
69 h677 1.2 FRetStrings := TStringList.Create;
70 h677 1.4 FCreateNGwordFile := true;
71 h677 1.2 SetCutoffNum(0);
72 h677 1.1 end;
73    
74     destructor TAbon.Destroy;
75     begin
76 h677 1.2 FRetStrings.Free;
77 h677 1.1 inherited;
78     end;
79    
80    
81    
82     //rootはExeのいるフォルダ
83     procedure TAbon.Setroot(root :String);
84     begin
85     Froot := root;
86     end;
87     function TAbon.Getroot() : String;
88     begin
89     Result := Froot;
90     end;
91     //NGwordpathはNGword.txtのフルパス
92     procedure TAbon.SetNGwordpath(path :String);
93     begin
94     FNGwordpath := path;
95     LoadFromNGwordFile(FNGwordpath);
96     end;
97     function TAbon.GetNGwordpath() : String;
98     begin
99     Result := FNGwordpath;
100     end;
101     //NGwordファイルの読み込み
102     function TAbon.LoadFromNGwordFile(path :String) : boolean;
103     var
104     bufstl : TStringList;
105     i : integer;
106     begin
107     if AnsiPos(':\',path) <> 2 then begin //ドライブからのフルパスが無ければ
108     if Getroot() = '' then begin
109     Result := false; //rootパスが設定されてないからfalse
110     Exit;
111     end else begin
112     if (Froot[Length(Froot)] = '\') and (path[1] = '\') then begin //先頭の\を削除
113     Delete(path,1,1);
114     end;
115     Insert( Getroot(), path , 1);//rootパスを挿入
116     end;
117     end;
118     bufstl := TStringList.Create;
119     try
120     bufstl.LoadFromFile(path);
121 h677 1.3 for i := bufstl.Count -1 downto 0 do begin
122     if bufstl.Strings[i] = '' then begin
123     bufstl.Delete(i);
124     end;
125     end;
126 h677 1.2 SetLength(Ftokens,bufstl.Count);
127 h677 1.1 for i := 0 to bufstl.Count -1 do begin
128     SetTokens(i , bufstl.Strings[i]);
129     end;
130    
131     except
132 h677 1.3 if CreateNGwordFile = true then begin
133 h677 1.4 bufstl.SaveToFile(path);
134 h677 1.3 end;
135 h677 1.1 bufstl.Free;
136     Result := false;
137     Exit;
138     end;
139     bufstl.Free;
140     Result := true;
141     end;
142     //NGwordpathが既に設定されているときのリロード用関数
143     function TAbon.ReLoadFromNGwordFile() : boolean;
144     begin
145     if GetNGwordpath() ='' then begin
146     Result := false;
147     end else begin
148     Result := LoadFromNGwordFile( GetNGwordpath() );
149     end;
150     end;
151    
152     //一行の中のトークンを切り分けてセット
153     procedure TAbon.SetTokens(index: integer ; argline : String);
154     var
155     ret : Integer;
156     bufstl : TStringList;
157     i : Integer;
158     begin
159     bufstl := TStringList.Create;
160     bufstl.Delimiter := #9; //区切り子を’タブ’に設定
161     bufstl.DelimitedText := argline;
162     ret := bufstl.Count;
163 h677 1.2 SetLength(Ftokens[index],ret);
164 h677 1.1 for i := 0 to bufstl.Count - 1 do begin
165 h677 1.2 Ftokens[index][i] := bufstl.Strings[i];
166 h677 1.1 end;
167     bufstl.Free;
168    
169     end;
170 h677 1.2 procedure TAbon.SetCutoffNum(value : Integer);
171     begin
172 h677 1.3 if value > 0 then begin
173 h677 1.2 FCutoffNum := value;
174     end else begin
175     FCutoffNum := 0;
176     end;
177     end;
178     function TAbon.GetCutoffNum() : Integer;
179     begin
180     Result := FCutoffNum;
181     end;
182 h677 1.1 function TAbon.ShowAllTokens() : String;
183     var
184     i : Integer;
185     j : Integer;
186     ret : String;
187     begin
188 h677 1.2 for i := 0 to High(Ftokens) do begin
189     for j := 0 to High(Ftokens[i]) do begin
190     ret := ret + Ftokens[i][j];
191 h677 1.1 end;
192     end;
193     Result := ret;
194    
195    
196    
197     end;
198    
199     //****************************************************************************//
200     //NGワードが含まれてたらtrueを返す。
201     function TAbon.FindNGwords(line : String) : Boolean;
202     var
203     i : Integer;
204     j : Integer;
205     hit : Boolean;
206     begin
207     hit := false;
208     if AnsiPos(FAbonString,line) <> 1 then begin
209 h677 1.2 for i := 0 to High(Ftokens) do begin
210 h677 1.1 hit := true;
211 h677 1.2 for j := 0 to High(Ftokens[i]) do begin
212     if AnsiPos(Ftokens[i][j],line) = 0 then begin
213 h677 1.1 hit := false;
214     break;
215     end;
216     end;
217     if hit = true then begin
218     break;
219     end;
220     end;
221     end;
222     Result := hit;
223    
224     end;
225 h677 1.3 //CutOff値以上個の同じ英数が並んでいたらtrue
226     function TAbon.Cutoff(line : String) : Boolean;
227 h677 1.2 var
228     i : Integer;
229     sheed : AnsiChar;
230     buf : String;
231 h677 1.3 ret : Bool;
232 h677 1.2 begin
233 h677 1.3 ret := false;
234 h677 1.2 if FCutoffNum <> 0 then begin
235     for i := 65 to 90 do begin
236     sheed := Chr(i);
237     buf := DupeString(sheed, FCutoffNum);
238     if AnsiContainsText(line, buf) = true then begin
239 h677 1.3 ret := true;
240 h677 1.2 break;
241     end;
242     end;
243     end;
244     Result := ret;
245     end;
246 h677 1.1 //末尾のブール値はtrueだと、NGワードを含むものだけを返す。
247 h677 1.3 function TAbon.Execute(DestStrings : TStringList) : TStringList;
248 h677 1.1 var
249     i : Integer;
250 h677 1.2 bufline : String;
251     begin
252     FRetStrings.Clear;
253 h677 1.1
254 h677 1.3 if Reverse = false then begin
255 h677 1.1 for i:=0 to DestStrings.Count - 1 do begin
256 h677 1.2 if FindNGwords(DestStrings.Strings[i]) = true then begin
257     FRetStrings.Append(FAbonString);
258 h677 1.1 end else begin
259 h677 1.2 bufline := DestStrings.Strings[i];
260 h677 1.3 if Deleterlo = true then begin
261 h677 1.2 bufline := AnsiReplaceText( bufline,'&rlo;','' );
262     end;
263 h677 1.3 if Replaceul = true then begin
264 h677 1.2 bufline := AnsiReplaceText( bufline,'<ul>','<br>' );
265     bufline := AnsiReplaceText( bufline,'</ul>','<br>' );
266     end;
267     FRetStrings.Append(bufline);
268 h677 1.1 end;
269     end;
270     end else begin
271     for i:=0 to DestStrings.Count - 1 do begin
272     if FindNGwords(DestStrings.Strings[i]) = false then begin
273 h677 1.2 FRetStrings.Append(FAbonString);
274 h677 1.1 end else begin
275 h677 1.2 bufline := DestStrings.Strings[i];
276 h677 1.3 if Deleterlo = true then begin
277 h677 1.2 while AnsiPos('&rlo',bufline) <> 0 do begin
278     Delete(bufline,AnsiPos('&rlo',bufline),4);
279     end;
280     end;
281 h677 1.3 if Replaceul = true then begin
282 h677 1.2 bufline := AnsiReplaceText( bufline,'<ul>','<br>' );
283     bufline := AnsiReplaceText( bufline,'</ul>','<br>' );
284     end;
285     FRetStrings.Append(bufline);
286 h677 1.1 end;
287     end;
288    
289     end;
290 h677 1.2 Result := FRetStrings;
291 h677 1.1
292     end;
293 h677 1.3 function TAbon.Execute(DestStrings : TStringList; NGwords : TStringList) : TStringList;
294 h677 1.1 var
295     i : Integer;
296     begin
297 h677 1.2 SetLength(Ftokens,NGwords.Count);
298 h677 1.1 for i := 0 to NGwords.Count -1 do begin
299     SetTokens(i , NGwords.Strings[i]);
300     end;
301 h677 1.3 Result := Execute(DestStrings);
302 h677 1.1
303     end;
304 h677 1.3 function TAbon.Execute(DestStrings : TStringList; NGwords : TStrings) : TStringList;
305 h677 1.1 var
306     i : Integer;
307     buf : TStringList;
308     begin
309     buf := TStringList.Create;
310     buf.AddStrings(NGwords);
311 h677 1.2 SetLength(Ftokens,buf.Count);
312 h677 1.1 for i := 0 to buf.Count -1 do begin
313     SetTokens(i , buf.Strings[i]);
314     end;
315 h677 1.3 Result := Execute(DestStrings);
316 h677 1.1 buf.Free;
317     end;
318    
319    
320     //****************************************************************************//
321     //DATを直にいじる奴ら===========================================================
322     //NGワードを含むレスの先頭にあぼーんを挿入
323     function TAbon.ExecuteFile(datfilepath : String; NGwordpath : String) : Boolean; //DATファイルを直にいじる
324     var
325     datstl : TStringList;
326     ret : Boolean;
327     i : Integer;
328     begin
329     datstl := TStringList.Create;
330     ret := true;
331     try
332     try
333     datstl.LoadFromFile(datfilepath);
334     for i := 0 to datstl.Count -1 do begin
335     if FindNGwords(datstl.Strings[i]) = true then begin
336     datstl.Strings[i] := FAbonString + datstl.Strings[i]
337     end;
338     end;
339    
340     datstl.SaveToFile(datfilepath);
341     except
342     ret := false;
343     end;
344     finally
345     datstl.Free;
346     end;
347     Result := ret;
348    
349     end;
350     //指定されたレス番の先頭にあぼーん挿入
351     function TAbon.ExecuteFile(datfilepath : String; resnum : Integer) : Boolean; //DATファイルを直にいじる
352     var
353     datstl : TStringList;
354     ret : Boolean;
355     begin
356     ret := true;
357     datstl := TStringList.Create;
358     try
359     try
360     datstl.LoadFromFile(datfilepath);
361     if (resnum > 0) and (resnum <= datstl.Count) then begin
362     if AnsiPos(FAbonString, datstl.Strings[resnum-1]) <> 1 then begin
363     datstl.Strings[resnum-1] := FAbonString + datstl.Strings[resnum-1];
364     end;
365     end;
366     datstl.SaveToFile(datfilepath);
367     except
368     ret := false;
369     end;
370     finally
371     datstl.Free;
372     end;
373     Result := ret;
374     end;
375     //firstresからcount個のレスの先頭にあぼーん挿入
376     function TAbon.ExecuteFile(datfilepath : String; firstres : Integer; count : Integer) : Boolean; //DATファイルを直にいじる
377     var
378     datstl : TStringList;
379     i : Integer;
380     endnum : Integer; //終わりのレス番
381     ret : Boolean;
382     begin
383     ret := true;
384     datstl := TStringList.Create;
385     try
386     try
387     datstl.LoadFromFile(datfilepath);
388     if (firstres > 0) and (firstres <= datstl.Count) then begin
389     if firstres + count -1 > datstl.Count then begin
390     endnum := datstl.Count;
391     end else if count <= 0 then begin
392     endnum := firstres + 1;
393     end else begin
394     endnum := firstres + count -1;
395     end;
396    
397     for i := firstres to endnum do begin
398     if AnsiPos(FAbonString, datstl.Strings[i-1]) <> 1 then begin
399     datstl.Strings[i-1] := FAbonString + datstl.Strings[i-1];
400     end;
401     end;
402     end;
403     datstl.SaveToFile(datfilepath);
404     except
405     ret := false;
406     end;
407     finally
408     datstl.Free;
409     end;
410     Result := ret;
411     end;
412     //DATを直にいじる奴ら==========ここまで=========================================
413    
414     //元に戻す奴ら==================================================================
415     function TAbon.ReverseExecuteFile(datfilepath : String) : Boolean; //DATファイルを直にいじる
416     var
417     datstl : TStringList;
418     i : Integer;
419     buf : String;
420     ret : Boolean;
421     begin
422     ret := true;
423     datstl := TStringList.Create;
424     try
425     try
426     datstl.LoadFromFile(datfilepath);
427     for i:=0 to datstl.Count -1 do begin
428     if AnsiPos(FAbonString, datstl.Strings[i]) = 1 then begin
429     buf := datstl.Strings[i];
430     Delete(buf,1,Length(FAbonString));
431     datstl.Strings[i] := buf;
432     end;
433     end;
434     datstl.SaveToFile(datfilepath);
435     except
436     ret := false;
437     end;
438     finally
439     datstl.Free;
440     end;
441     Result := ret;
442    
443     end;
444     function TAbon.ReverseExecuteFile(datfilepath : String; resnum : Integer) : Boolean; //DATファイルを直にいじる
445     var
446     datstl : TStringList;
447     buf : String;
448     ret : Boolean;
449     begin
450     ret := true;
451     datstl := TStringList.Create;
452     try
453     try
454     datstl.LoadFromFile(datfilepath);
455     if (resnum > 0) and (resnum <= datstl.Count) then begin
456     if AnsiPos(FAbonString, datstl.Strings[resnum-1]) = 1 then begin
457     buf := datstl.Strings[resnum-1];
458     Delete(buf,1,Length(FAbonString));
459     datstl.Strings[resnum-1] := buf;
460     end;
461     end;
462     datstl.SaveToFile(datfilepath);
463     except
464     ret := false;
465     end;
466     finally
467     datstl.Free;
468     end;
469     Result := ret;
470    
471     end;
472     function TAbon.ReverseExecuteFile(datfilepath : String; firstres : Integer; count : Integer) : Boolean;//DATファイルを直にいじる
473     var
474     datstl : TStringList;
475     i : Integer;
476     endnum : Integer; //終わりのレス番
477     buf : String;
478     ret : Boolean;
479     begin
480     ret := true;
481     datstl := TStringList.Create;
482     try
483     try
484     datstl.LoadFromFile(datfilepath);
485     if (firstres > 0) and (firstres <= datstl.Count) then begin
486     if firstres + count -1 > datstl.Count then begin
487     endnum := datstl.Count;
488     end else if count <= 0 then begin
489     endnum := firstres + 1;
490     end else begin
491     endnum := firstres + count -1;
492     end;
493     for i := firstres to endnum do begin
494     if AnsiPos(FAbonString, datstl.Strings[i-1]) = 1 then begin
495     buf := datstl.Strings[i-1];
496     Delete(buf,1,Length(FAbonString));
497     datstl.Strings[i-1] := buf;
498     end;
499     end;
500     end;
501     datstl.SaveToFile(datfilepath);
502     except
503     ret := false;
504     end;
505     finally
506     datstl.Free;
507     end;
508     Result := ret;
509     end;
510     //元に戻す奴ら=================ここまで=========================================
511     //現在セットされているNGword.txtを開く
512     procedure TAbon.EditNGwords();
513     begin
514     ShellExecute(0 ,nil,PChar(FNGwordpath),nil,nil,SW_SHOW);
515     end;
516 h677 1.3 function TAbon.CheckAbonPopupRes(line : String) :Boolean;
517     var
518     i : Integer;
519     begin
520     if FCutoffNum = 0 then begin
521     if AbonPopupRes = true then begin
522     Result := FindNGwords(line);
523     end else begin
524     Result := false;
525     end;
526     end else begin
527     if AbonPopupRes = true then begin
528     Result := FindNGwords(line);
529     if Result = false then begin
530     for i := 0 to 2 do begin
531     Delete(line,1,Ansipos('<>',line)+1);
532     end;
533     Delete(line,Ansipos('<>',line),Length(line)-Ansipos('<>',line)+1);
534     Result := Cutoff(line);
535     end;
536     end else begin
537     Result := false;
538     end;
539     end;
540     end;
541 h677 1.1
542    
543     end.
544    

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