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.10 - (show annotations) (download) (as text)
Tue Aug 19 10:48:31 2003 UTC (20 years, 8 months ago) by h677
Branch: MAIN
CVS Tags: b35, b36
Changes since 1.9: +29 -21 lines
File MIME type: text/x-pascal
関数の清書と、NGの判断の変更(タブで区切られたNGワードでは、それぞれが別に含まれて無いとNGとしないようにした。)

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

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