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.6 - (show annotations) (download) (as text)
Wed Aug 13 19:37:48 2003 UTC (20 years, 8 months ago) by yoffy
Branch: MAIN
CVS Tags: b34
Changes since 1.5: +24 -11 lines
File MIME type: text/x-pascal
・NGワードをファイルからだけではなく直接メモリから読み込めるよう、LoadFromStringList を追加。

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 絎h? }
11 Froot : String;
12 FNGwordpath : String;
13 Ftokens : array of array of string;
14 FAbonString : String;
15 FRetStrings : TStringList;
16 FCutoffNum : Integer; //?????遺札筝??g??????????怨???NG???若????????
17 FDeleterlo : Boolean; //&rlo;????????
18 FReplaceul :Boolean ; //<ul>?帥?違??<br>?帥?違??舟????????
19 FReverse : Boolean ; //NG???若???с?????若?????????????荵≪????????
20 FAbonPopupRes : Boolean; //???鴻???????≪?????????????若?若????????
21 FCreateNGwordFile : Boolean; //??絎???????path??G???若??txt???<???c??????????????????????????
22 procedure SetTokens(index: integer ; argline:String);
23
24 public
25 { Public 絎h? }
26 constructor Create; // ?潟?潟?鴻????????/span>
27 destructor Destroy; override; // ???鴻????????/span>
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 procedure LoadFromStringList( bufstl : TStringList );
43 function CheckAbonPopupRes(line : String) :Boolean;
44 function FindNGwords(line : String) : Boolean; //1???ゃ?潟???ょ????
45 function Cutoff(line : String) : Boolean; //CutOff?や札筝??????????掩?違??筝????с??????true
46 //???若????????
47 function Execute(DestStrings : TStringList) : TStringList; overload;
48 function Execute(DestStrings : TStringList; NGwords : TStringList) : TStringList; overload;
49 function Execute(DestStrings : TStringList; NGwords : TStrings) : TStringList; overload;
50 //--
51 function ExecuteFile(datfilepath : String; NGwordpath : String) : Boolean; overload;//DAT???<?ゃ?????眼????????
52 function ExecuteFile(datfilepath : String; resnum : Integer) : Boolean; overload; //DAT???<?ゃ?????眼????????
53 function ExecuteFile(datfilepath : String; firstres : Integer; count : Integer) : Boolean; overload; //DAT???<?ゃ?????眼????????
54 function ReverseExecuteFile(datfilepath : String) : Boolean; overload; //DAT???<?ゃ?????眼????????
55 function ReverseExecuteFile(datfilepath : String; resnum : Integer) : Boolean; overload; //DAT???<?ゃ?????眼????????
56 function ReverseExecuteFile(datfilepath : String; firstres : Integer; count : Integer) : Boolean; overload; //DAT???<?ゃ?????眼????????
57 //--
58 procedure EditNGwords(); //NGword.txt???????
59 function ShowAllTokens() : String; //???????亥??/span>
60 end;
61 var
62 Abon1 :TAbon;
63
64 implementation
65
66 constructor TAbon.Create;
67 begin
68 // ??????
69 FAbonString := '&nbsp;<>&nbsp;<>&nbsp;<>&nbsp;&nbsp;<><>';
70 FRetStrings := TStringList.Create;
71 FCreateNGwordFile := true;
72 SetCutoffNum(0);
73 end;
74
75 destructor TAbon.Destroy;
76 begin
77 FRetStrings.Free;
78 inherited;
79 end;
80
81
82
83 //root??xe??????????????
84 procedure TAbon.Setroot(root :String);
85 begin
86 Froot := root;
87 end;
88 function TAbon.Getroot() : String;
89 begin
90 Result := Froot;
91 end;
92 //NGwordpath??Gword.txt??????????/span>
93 procedure TAbon.SetNGwordpath(path :String);
94 begin
95 FNGwordpath := path;
96 LoadFromNGwordFile(FNGwordpath);
97 end;
98 function TAbon.GetNGwordpath() : String;
99 begin
100 Result := FNGwordpath;
101 end;
102 //NGword???<?ゃ??????粋昭??/span>
103 function TAbon.LoadFromNGwordFile(path :String) : boolean;
104 var
105 bufstl : TStringList;
106 i : integer;
107 begin
108 if AnsiPos(':\',path) <> 2 then begin //?????ゃ???????????????鴻???<??????/span>
109 if Getroot() = '' then begin
110 Result := false; //root???鴻??荐????????????????false
111 Exit;
112 end else begin
113 if (Froot[Length(Froot)] = '\') and (path[1] = '\') then begin //????????????/span>
114 Delete(path,1,1);
115 end;
116 Insert( Getroot(), path , 1);//root???鴻???水??/span>
117 end;
118 end;
119 bufstl := TStringList.Create;
120 try
121 bufstl.LoadFromFile(path);
122 LoadFromStringList( bufstl );
123
124 except
125 if CreateNGwordFile = true then begin
126 bufstl.SaveToFile(path);
127 end;
128 bufstl.Free;
129 Result := false;
130 Exit;
131 end;
132 bufstl.Free;
133 Result := true;
134 end;
135 //NGword???鴻??茯??粋昭??/span>
136 procedure TAbon.LoadFromStringList( bufstl : TStringList );
137 var
138 i : integer;
139 begin
140 try
141 for i := bufstl.Count -1 downto 0 do begin
142 if bufstl.Strings[i] = '' then begin
143 bufstl.Delete(i);
144 end;
145 end;
146 SetLength(Ftokens,bufstl.Count);
147 for i := 0 to bufstl.Count -1 do begin
148 SetTokens(i , bufstl.Strings[i]);
149 end;
150
151 except
152 Exit;
153 end;
154 end;
155 //NGwordpath???≪??┃絎??????????????????????若?????∽??/span>
156 function TAbon.ReLoadFromNGwordFile() : boolean;
157 begin
158 if GetNGwordpath() ='' then begin
159 Result := false;
160 end else begin
161 Result := LoadFromNGwordFile( GetNGwordpath() );
162 end;
163 end;
164
165 //筝?茵???賢?????若???潟?????????????祉????
166 procedure TAbon.SetTokens(index: integer ; argline : String);
167 var
168 ret : Integer;
169 bufstl : TStringList;
170 i : Integer;
171 begin
172 bufstl := TStringList.Create;
173 bufstl.Delimiter := #9; //?阪????絖??????帥??????┃絎?
174 bufstl.DelimitedText := argline;
175 ret := bufstl.Count;
176 SetLength(Ftokens[index],ret);
177 for i := 0 to bufstl.Count - 1 do begin
178 Ftokens[index][i] := bufstl.Strings[i];
179 end;
180 bufstl.Free;
181
182 end;
183 procedure TAbon.SetCutoffNum(value : Integer);
184 begin
185 if value > 0 then begin
186 FCutoffNum := value;
187 end else begin
188 FCutoffNum := 0;
189 end;
190 end;
191 function TAbon.GetCutoffNum() : Integer;
192 begin
193 Result := FCutoffNum;
194 end;
195 function TAbon.ShowAllTokens() : String;
196 var
197 i : Integer;
198 j : Integer;
199 ret : String;
200 begin
201 for i := 0 to High(Ftokens) do begin
202 for j := 0 to High(Ftokens[i]) do begin
203 ret := ret + Ftokens[i][j];
204 end;
205 end;
206 Result := ret;
207
208
209
210 end;
211
212 //****************************************************************************//
213 //NG???若???????障????????true??菴?????
214 function TAbon.FindNGwords(line : String) : Boolean;
215 var
216 i : Integer;
217 j : Integer;
218 hit : Boolean;
219 begin
220 hit := false;
221 if AnsiPos(FAbonString,line) <> 1 then begin
222 for i := 0 to High(Ftokens) do begin
223 hit := true;
224 for j := 0 to High(Ftokens[i]) do begin
225 if AnsiPos(Ftokens[i][j],line) = 0 then begin
226 hit := false;
227 break;
228 end;
229 end;
230 if hit = true then begin
231 break;
232 end;
233 end;
234 end;
235 Result := hit;
236
237 end;
238 //CutOff?や札筝??????????掩?違??筝????с??????true
239 function TAbon.Cutoff(line : String) : Boolean;
240 var
241 i : Integer;
242 sheed : AnsiChar;
243 buf : String;
244 ret : Bool;
245 begin
246 ret := false;
247 if FCutoffNum <> 0 then begin
248 for i := 65 to 90 do begin
249 sheed := Chr(i);
250 buf := DupeString(sheed, FCutoffNum);
251 if AnsiContainsText(line, buf) = true then begin
252 ret := true;
253 break;
254 end;
255 end;
256 end;
257 Result := ret;
258 end;
259 //??鮎?????若???ゃ??rue??????NG???若??????????????????菴?????
260 function TAbon.Execute(DestStrings : TStringList) : TStringList;
261 var
262 i : Integer;
263 j : Integer;
264 bufline : String;
265 begin
266 FRetStrings.Clear;
267
268 //if Reverse = false then begin
269 for i:=0 to DestStrings.Count - 1 do begin
270 if FindNGwords(DestStrings.Strings[i]) <> Reverse then begin
271 FRetStrings.Append(FAbonString);
272 end else if FCutoffNum > 0 then begin
273 bufline := DestStrings.Strings[i];
274 for j := 0 to 2 do begin
275 Delete(bufline,1,Ansipos('<>',bufline)+1);
276 end;
277 Delete(bufline,Ansipos('<>',bufline),Length(bufline)-Ansipos('<>',bufline)+1);
278 if Cutoff(bufline) = true then begin
279 FRetStrings.Append(FAbonString);
280 end else begin
281 bufline := DestStrings.Strings[i];
282 if Deleterlo = true then begin
283 bufline := AnsiReplaceText( bufline,'&rlo;','' );
284 end;
285 if Replaceul = true then begin
286 bufline := AnsiReplaceText( bufline,'<ul>','<br>' );
287 bufline := AnsiReplaceText( bufline,'</ul>','<br>' );
288 end;
289 FRetStrings.Append(bufline);
290 end;
291 end else begin
292 bufline := DestStrings.Strings[i];
293 if Deleterlo = true then begin
294 bufline := AnsiReplaceText( bufline,'&rlo;','' );
295 end;
296 if Replaceul = true then begin
297 bufline := AnsiReplaceText( bufline,'<ul>','<br>' );
298 bufline := AnsiReplaceText( bufline,'</ul>','<br>' );
299 end;
300 FRetStrings.Append(bufline);
301 end;
302 end;
303 {end else begin
304 for i:=0 to DestStrings.Count - 1 do begin
305 if FindNGwords(DestStrings.Strings[i]) = false then begin
306 bufline := DestStrings.Strings[i];
307 for j := 0 to 2 do begin
308 Delete(bufline,1,Ansipos('<>',bufline)+1);
309 end;
310 Delete(bufline,Ansipos('<>',bufline),Length(bufline)-Ansipos('<>',bufline)+1);
311 if Cutoff(bufline) = false then begin
312 FRetStrings.Append(FAbonString);
313 end else begin
314 bufline := DestStrings.Strings[i];
315 if Deleterlo = true then begin
316 while AnsiPos('&rlo',bufline) <> 0 do begin
317 Delete(bufline,AnsiPos('&rlo',bufline),4);
318 end;
319 end;
320 if Replaceul = true then begin
321 bufline := AnsiReplaceText( bufline,'<ul>','<br>' );
322 bufline := AnsiReplaceText( bufline,'</ul>','<br>' );
323 end;
324 FRetStrings.Append(bufline);
325 end;
326 end else begin
327 bufline := DestStrings.Strings[i];
328 if Deleterlo = true then begin
329 while AnsiPos('&rlo',bufline) <> 0 do begin
330 Delete(bufline,AnsiPos('&rlo',bufline),4);
331 end;
332 end;
333 if Replaceul = true then begin
334 bufline := AnsiReplaceText( bufline,'<ul>','<br>' );
335 bufline := AnsiReplaceText( bufline,'</ul>','<br>' );
336 end;
337 FRetStrings.Append(bufline);
338 end;
339 end;
340
341 end;}
342 Result := FRetStrings;
343
344 end;
345 function TAbon.Execute(DestStrings : TStringList; NGwords : TStringList) : TStringList;
346 var
347 i : Integer;
348 begin
349 SetLength(Ftokens,NGwords.Count);
350 for i := 0 to NGwords.Count -1 do begin
351 SetTokens(i , NGwords.Strings[i]);
352 end;
353 Result := Execute(DestStrings);
354
355 end;
356 function TAbon.Execute(DestStrings : TStringList; NGwords : TStrings) : TStringList;
357 var
358 i : Integer;
359 buf : TStringList;
360 begin
361 buf := TStringList.Create;
362 buf.AddStrings(NGwords);
363 SetLength(Ftokens,buf.Count);
364 for i := 0 to buf.Count -1 do begin
365 SetTokens(i , buf.Strings[i]);
366 end;
367 Result := Execute(DestStrings);
368 buf.Free;
369 end;
370
371
372 //****************************************************************************//
373 //DAT???眼????????絅眼??===========================================================
374 //NG???若???????????鴻???????????若?若?????水??/span>
375 function TAbon.ExecuteFile(datfilepath : String; NGwordpath : String) : Boolean; //DAT???<?ゃ?????眼????????
376 var
377 datstl : TStringList;
378 ret : Boolean;
379 i : Integer;
380 begin
381 datstl := TStringList.Create;
382 ret := true;
383 try
384 try
385 datstl.LoadFromFile(datfilepath);
386 for i := 0 to datstl.Count -1 do begin
387 if FindNGwords(datstl.Strings[i]) = true then begin
388 datstl.Strings[i] := FAbonString + datstl.Strings[i]
389 end;
390 end;
391
392 datstl.SaveToFile(datfilepath);
393 except
394 ret := false;
395 end;
396 finally
397 datstl.Free;
398 end;
399 Result := ret;
400
401 end;
402 //??絎??????????合?????????????若?若???水??/span>
403 function TAbon.ExecuteFile(datfilepath : String; resnum : Integer) : Boolean; //DAT???<?ゃ?????眼????????
404 var
405 datstl : TStringList;
406 ret : Boolean;
407 begin
408 ret := true;
409 datstl := TStringList.Create;
410 try
411 try
412 datstl.LoadFromFile(datfilepath);
413 if (resnum > 0) and (resnum <= datstl.Count) then begin
414 if AnsiPos(FAbonString, datstl.Strings[resnum-1]) <> 1 then begin
415 datstl.Strings[resnum-1] := FAbonString + datstl.Strings[resnum-1];
416 end;
417 end;
418 datstl.SaveToFile(datfilepath);
419 except
420 ret := false;
421 end;
422 finally
423 datstl.Free;
424 end;
425 Result := ret;
426 end;
427 //firstres????count???????鴻???????????若?若???水??/span>
428 function TAbon.ExecuteFile(datfilepath : String; firstres : Integer; count : Integer) : Boolean; //DAT???<?ゃ?????眼????????
429 var
430 datstl : TStringList;
431 i : Integer;
432 endnum : Integer; //腟?????????合??/span>
433 ret : Boolean;
434 begin
435 ret := true;
436 datstl := TStringList.Create;
437 try
438 try
439 datstl.LoadFromFile(datfilepath);
440 if (firstres > 0) and (firstres <= datstl.Count) then begin
441 if firstres + count -1 > datstl.Count then begin
442 endnum := datstl.Count;
443 end else if count <= 0 then begin
444 endnum := firstres + 1;
445 end else begin
446 endnum := firstres + count -1;
447 end;
448
449 for i := firstres to endnum do begin
450 if AnsiPos(FAbonString, datstl.Strings[i-1]) <> 1 then begin
451 datstl.Strings[i-1] := FAbonString + datstl.Strings[i-1];
452 end;
453 end;
454 end;
455 datstl.SaveToFile(datfilepath);
456 except
457 ret := false;
458 end;
459 finally
460 datstl.Free;
461 end;
462 Result := ret;
463 end;
464 //DAT???眼????????絅眼??==========?????障??========================================
465
466 //?????祉??絅眼??==================================================================
467 function TAbon.ReverseExecuteFile(datfilepath : String) : Boolean; //DAT???<?ゃ?????眼????????
468 var
469 datstl : TStringList;
470 i : Integer;
471 buf : String;
472 ret : Boolean;
473 begin
474 ret := true;
475 datstl := TStringList.Create;
476 try
477 try
478 datstl.LoadFromFile(datfilepath);
479 for i:=0 to datstl.Count -1 do begin
480 if AnsiPos(FAbonString, datstl.Strings[i]) = 1 then begin
481 buf := datstl.Strings[i];
482 Delete(buf,1,Length(FAbonString));
483 datstl.Strings[i] := buf;
484 end;
485 end;
486 datstl.SaveToFile(datfilepath);
487 except
488 ret := false;
489 end;
490 finally
491 datstl.Free;
492 end;
493 Result := ret;
494
495 end;
496 function TAbon.ReverseExecuteFile(datfilepath : String; resnum : Integer) : Boolean; //DAT???<?ゃ?????眼????????
497 var
498 datstl : TStringList;
499 buf : String;
500 ret : Boolean;
501 begin
502 ret := true;
503 datstl := TStringList.Create;
504 try
505 try
506 datstl.LoadFromFile(datfilepath);
507 if (resnum > 0) and (resnum <= datstl.Count) then begin
508 if AnsiPos(FAbonString, datstl.Strings[resnum-1]) = 1 then begin
509 buf := datstl.Strings[resnum-1];
510 Delete(buf,1,Length(FAbonString));
511 datstl.Strings[resnum-1] := buf;
512 end;
513 end;
514 datstl.SaveToFile(datfilepath);
515 except
516 ret := false;
517 end;
518 finally
519 datstl.Free;
520 end;
521 Result := ret;
522
523 end;
524 function TAbon.ReverseExecuteFile(datfilepath : String; firstres : Integer; count : Integer) : Boolean;//DAT???<?ゃ?????眼????????
525 var
526 datstl : TStringList;
527 i : Integer;
528 endnum : Integer; //腟?????????合??/span>
529 buf : String;
530 ret : Boolean;
531 begin
532 ret := true;
533 datstl := TStringList.Create;
534 try
535 try
536 datstl.LoadFromFile(datfilepath);
537 if (firstres > 0) and (firstres <= datstl.Count) then begin
538 if firstres + count -1 > datstl.Count then begin
539 endnum := datstl.Count;
540 end else if count <= 0 then begin
541 endnum := firstres + 1;
542 end else begin
543 endnum := firstres + count -1;
544 end;
545 for i := firstres to endnum do begin
546 if AnsiPos(FAbonString, datstl.Strings[i-1]) = 1 then begin
547 buf := datstl.Strings[i-1];
548 Delete(buf,1,Length(FAbonString));
549 datstl.Strings[i-1] := buf;
550 end;
551 end;
552 end;
553 datstl.SaveToFile(datfilepath);
554 except
555 ret := false;
556 end;
557 finally
558 datstl.Free;
559 end;
560 Result := ret;
561 end;
562 //?????祉??絅眼??=================?????障??========================================
563 //?上???祉??????????????NGword.txt??????span>
564 procedure TAbon.EditNGwords();
565 begin
566 ShellExecute(0 ,nil,PChar(FNGwordpath),nil,nil,SW_SHOW);
567 end;
568 function TAbon.CheckAbonPopupRes(line : String) :Boolean;
569 var
570 i : Integer;
571 begin
572 if FCutoffNum = 0 then begin
573 if AbonPopupRes = true then begin
574 Result := FindNGwords(line);
575 end else begin
576 Result := false;
577 end;
578 end else begin
579 if AbonPopupRes = true then begin
580 Result := FindNGwords(line);
581 if Result = false then begin
582 for i := 0 to 2 do begin
583 Delete(line,1,Ansipos('<>',line)+1);
584 end;
585 Delete(line,Ansipos('<>',line),Length(line)-Ansipos('<>',line)+1);
586 Result := Cutoff(line);
587 end;
588 end else begin
589 Result := false;
590 end;
591 end;
592 end;
593
594
595 end.
596

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