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

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