Develop and Download Open Source Software

Browse CVS Repository

Contents of /gikonavigoeson/gikonavi/AbonUnit.pas

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


Revision 1.4 - (show 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 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 宣言 }
11 Froot : String;
12 FNGwordpath : String;
13 Ftokens : array of array of string;
14 FAbonString : String;
15 FRetStrings : TStringList;
16 FCutoffNum : Integer; //この数以上連続する同じ英字をNGワードとする
17 FDeleterlo : Boolean; //&rlo;を削るか
18 FReplaceul :Boolean ; //<ul>タグを<br>タグに置換するか
19 FReverse : Boolean ; //NGワードでのあぼ〜んの結果を反転させるか
20 FAbonPopupRes : Boolean; //レスポップアップの時にあぼーんするか
21 FCreateNGwordFile : Boolean; //指定されたpathにNGワードtxtが無かったときに自動的に生成するか
22 procedure SetTokens(index: integer ; argline:String);
23
24 public
25 { Public 宣言 }
26 constructor Create; // コンストラクタ
27 destructor Destroy; override; // デストラクタ
28 property Deleterlo: Boolean read FDeleterlo write FDeleterlo default false;
29 property Replaceul: Boolean read FReplaceul write FReplaceul default false;
30 property Reverse: Boolean read FReverse write FReverse default false;
31 property CreateNGwordFile: Boolean read FCreateNGwordFile write FCreateNGwordFile;
32 property AbonString : String read FAbonString write FAbonString;
33 property AbonPopupRes : Boolean read FAbonPopupRes write FAbonPopupRes default false;
34 procedure Setroot(root :String);
35 function Getroot() : String;
36 procedure SetNGwordpath(path :String);
37 function GetNGwordpath() : String;
38 procedure SetCutoffNum(value : Integer);
39 function GetCutoffNum() : Integer;
40 function LoadFromNGwordFile(path :String) : Boolean;
41 function ReLoadFromNGwordFile() : Boolean;
42 function CheckAbonPopupRes(line : String) :Boolean;
43 function FindNGwords(line : String) : Boolean; //1ラインずつ用。
44 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 //--
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 FRetStrings := TStringList.Create;
70 FCreateNGwordFile := true;
71 SetCutoffNum(0);
72 end;
73
74 destructor TAbon.Destroy;
75 begin
76 FRetStrings.Free;
77 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 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 SetLength(Ftokens,bufstl.Count);
127 for i := 0 to bufstl.Count -1 do begin
128 SetTokens(i , bufstl.Strings[i]);
129 end;
130
131 except
132 if CreateNGwordFile = true then begin
133 bufstl.SaveToFile(path);
134 end;
135 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 SetLength(Ftokens[index],ret);
164 for i := 0 to bufstl.Count - 1 do begin
165 Ftokens[index][i] := bufstl.Strings[i];
166 end;
167 bufstl.Free;
168
169 end;
170 procedure TAbon.SetCutoffNum(value : Integer);
171 begin
172 if value > 0 then begin
173 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 function TAbon.ShowAllTokens() : String;
183 var
184 i : Integer;
185 j : Integer;
186 ret : String;
187 begin
188 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 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 for i := 0 to High(Ftokens) do begin
210 hit := true;
211 for j := 0 to High(Ftokens[i]) do begin
212 if AnsiPos(Ftokens[i][j],line) = 0 then begin
213 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 //CutOff値以上個の同じ英数が並んでいたらtrue
226 function TAbon.Cutoff(line : String) : Boolean;
227 var
228 i : Integer;
229 sheed : AnsiChar;
230 buf : String;
231 ret : Bool;
232 begin
233 ret := false;
234 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 ret := true;
240 break;
241 end;
242 end;
243 end;
244 Result := ret;
245 end;
246 //末尾のブール値はtrueだと、NGワードを含むものだけを返す。
247 function TAbon.Execute(DestStrings : TStringList) : TStringList;
248 var
249 i : Integer;
250 bufline : String;
251 begin
252 FRetStrings.Clear;
253
254 if Reverse = false then begin
255 for i:=0 to DestStrings.Count - 1 do begin
256 if FindNGwords(DestStrings.Strings[i]) = true then begin
257 FRetStrings.Append(FAbonString);
258 end else begin
259 bufline := DestStrings.Strings[i];
260 if Deleterlo = true then begin
261 bufline := AnsiReplaceText( bufline,'&rlo;','' );
262 end;
263 if Replaceul = true then begin
264 bufline := AnsiReplaceText( bufline,'<ul>','<br>' );
265 bufline := AnsiReplaceText( bufline,'</ul>','<br>' );
266 end;
267 FRetStrings.Append(bufline);
268 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 FRetStrings.Append(FAbonString);
274 end else begin
275 bufline := DestStrings.Strings[i];
276 if Deleterlo = true then begin
277 while AnsiPos('&rlo',bufline) <> 0 do begin
278 Delete(bufline,AnsiPos('&rlo',bufline),4);
279 end;
280 end;
281 if Replaceul = true then begin
282 bufline := AnsiReplaceText( bufline,'<ul>','<br>' );
283 bufline := AnsiReplaceText( bufline,'</ul>','<br>' );
284 end;
285 FRetStrings.Append(bufline);
286 end;
287 end;
288
289 end;
290 Result := FRetStrings;
291
292 end;
293 function TAbon.Execute(DestStrings : TStringList; NGwords : TStringList) : TStringList;
294 var
295 i : Integer;
296 begin
297 SetLength(Ftokens,NGwords.Count);
298 for i := 0 to NGwords.Count -1 do begin
299 SetTokens(i , NGwords.Strings[i]);
300 end;
301 Result := Execute(DestStrings);
302
303 end;
304 function TAbon.Execute(DestStrings : TStringList; NGwords : TStrings) : TStringList;
305 var
306 i : Integer;
307 buf : TStringList;
308 begin
309 buf := TStringList.Create;
310 buf.AddStrings(NGwords);
311 SetLength(Ftokens,buf.Count);
312 for i := 0 to buf.Count -1 do begin
313 SetTokens(i , buf.Strings[i]);
314 end;
315 Result := Execute(DestStrings);
316 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 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
542
543 end.
544

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