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.5 - (show annotations) (download) (as text)
Wed Aug 13 07:24:38 2003 UTC (20 years, 8 months ago) by h677
Branch: MAIN
Changes since 1.4: +42 -3 lines
File MIME type: text/x-pascal
連続するx個の同英字をあぼーんする処理の速度向上

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 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 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??xe??????????????
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??Gword.txt??????????/span>
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???<?ゃ??????粋昭??/span>
102 function TAbon.LoadFromNGwordFile(path :String) : boolean;
103 var
104 bufstl : TStringList;
105 i : integer;
106 begin
107 if AnsiPos(':\',path) <> 2 then begin //?????ゃ???????????????鴻???<??????/span>
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 //????????????/span>
113 Delete(path,1,1);
114 end;
115 Insert( Getroot(), path , 1);//root???鴻???水??/span>
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???≪??┃絎??????????????????????若?????∽??/span>
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 //??鮎?????若???ゃ??rue??????NG???若??????????????????菴?????
247 function TAbon.Execute(DestStrings : TStringList) : TStringList;
248 var
249 i : Integer;
250 j : Integer;
251 bufline : String;
252 begin
253 FRetStrings.Clear;
254
255 if Reverse = false then begin
256 for i:=0 to DestStrings.Count - 1 do begin
257 if FindNGwords(DestStrings.Strings[i]) = true then begin
258 FRetStrings.Append(FAbonString);
259 end else if FCutoffNum > 0 then begin
260 bufline := DestStrings.Strings[i];
261 for j := 0 to 2 do begin
262 Delete(bufline,1,Ansipos('<>',bufline)+1);
263 end;
264 Delete(bufline,Ansipos('<>',bufline),Length(bufline)-Ansipos('<>',bufline)+1);
265 if Cutoff(bufline) = true then begin
266 FRetStrings.Append(FAbonString);
267 end else begin
268 bufline := DestStrings.Strings[i];
269 if Deleterlo = true then begin
270 bufline := AnsiReplaceText( bufline,'&rlo;','' );
271 end;
272 if Replaceul = true then begin
273 bufline := AnsiReplaceText( bufline,'<ul>','<br>' );
274 bufline := AnsiReplaceText( bufline,'</ul>','<br>' );
275 end;
276 FRetStrings.Append(bufline);
277 end;
278 end else begin
279 bufline := DestStrings.Strings[i];
280 if Deleterlo = true then begin
281 bufline := AnsiReplaceText( bufline,'&rlo;','' );
282 end;
283 if Replaceul = true then begin
284 bufline := AnsiReplaceText( bufline,'<ul>','<br>' );
285 bufline := AnsiReplaceText( bufline,'</ul>','<br>' );
286 end;
287 FRetStrings.Append(bufline);
288 end;
289 end;
290 end else begin
291 for i:=0 to DestStrings.Count - 1 do begin
292 if FindNGwords(DestStrings.Strings[i]) = false then begin
293 bufline := DestStrings.Strings[i];
294 for j := 0 to 2 do begin
295 Delete(bufline,1,Ansipos('<>',bufline)+1);
296 end;
297 Delete(bufline,Ansipos('<>',bufline),Length(bufline)-Ansipos('<>',bufline)+1);
298 if Cutoff(bufline) = false then begin
299 FRetStrings.Append(FAbonString);
300 end else begin
301 bufline := DestStrings.Strings[i];
302 if Deleterlo = true then begin
303 while AnsiPos('&rlo',bufline) <> 0 do begin
304 Delete(bufline,AnsiPos('&rlo',bufline),4);
305 end;
306 end;
307 if Replaceul = true then begin
308 bufline := AnsiReplaceText( bufline,'<ul>','<br>' );
309 bufline := AnsiReplaceText( bufline,'</ul>','<br>' );
310 end;
311 FRetStrings.Append(bufline);
312 end;
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;
327
328 end;
329 Result := FRetStrings;
330
331 end;
332 function TAbon.Execute(DestStrings : TStringList; NGwords : TStringList) : TStringList;
333 var
334 i : Integer;
335 begin
336 SetLength(Ftokens,NGwords.Count);
337 for i := 0 to NGwords.Count -1 do begin
338 SetTokens(i , NGwords.Strings[i]);
339 end;
340 Result := Execute(DestStrings);
341
342 end;
343 function TAbon.Execute(DestStrings : TStringList; NGwords : TStrings) : TStringList;
344 var
345 i : Integer;
346 buf : TStringList;
347 begin
348 buf := TStringList.Create;
349 buf.AddStrings(NGwords);
350 SetLength(Ftokens,buf.Count);
351 for i := 0 to buf.Count -1 do begin
352 SetTokens(i , buf.Strings[i]);
353 end;
354 Result := Execute(DestStrings);
355 buf.Free;
356 end;
357
358
359 //****************************************************************************//
360 //DAT???眼????????絅眼??===========================================================
361 //NG???若???????????鴻???????????若?若?????水??/span>
362 function TAbon.ExecuteFile(datfilepath : String; NGwordpath : String) : Boolean; //DAT???<?ゃ?????眼????????
363 var
364 datstl : TStringList;
365 ret : Boolean;
366 i : Integer;
367 begin
368 datstl := TStringList.Create;
369 ret := true;
370 try
371 try
372 datstl.LoadFromFile(datfilepath);
373 for i := 0 to datstl.Count -1 do begin
374 if FindNGwords(datstl.Strings[i]) = true then begin
375 datstl.Strings[i] := FAbonString + datstl.Strings[i]
376 end;
377 end;
378
379 datstl.SaveToFile(datfilepath);
380 except
381 ret := false;
382 end;
383 finally
384 datstl.Free;
385 end;
386 Result := ret;
387
388 end;
389 //??絎??????????合?????????????若?若???水??/span>
390 function TAbon.ExecuteFile(datfilepath : String; resnum : Integer) : Boolean; //DAT???<?ゃ?????眼????????
391 var
392 datstl : TStringList;
393 ret : Boolean;
394 begin
395 ret := true;
396 datstl := TStringList.Create;
397 try
398 try
399 datstl.LoadFromFile(datfilepath);
400 if (resnum > 0) and (resnum <= datstl.Count) then begin
401 if AnsiPos(FAbonString, datstl.Strings[resnum-1]) <> 1 then begin
402 datstl.Strings[resnum-1] := FAbonString + datstl.Strings[resnum-1];
403 end;
404 end;
405 datstl.SaveToFile(datfilepath);
406 except
407 ret := false;
408 end;
409 finally
410 datstl.Free;
411 end;
412 Result := ret;
413 end;
414 //firstres????count???????鴻???????????若?若???水??/span>
415 function TAbon.ExecuteFile(datfilepath : String; firstres : Integer; count : Integer) : Boolean; //DAT???<?ゃ?????眼????????
416 var
417 datstl : TStringList;
418 i : Integer;
419 endnum : Integer; //腟?????????合??/span>
420 ret : Boolean;
421 begin
422 ret := true;
423 datstl := TStringList.Create;
424 try
425 try
426 datstl.LoadFromFile(datfilepath);
427 if (firstres > 0) and (firstres <= datstl.Count) then begin
428 if firstres + count -1 > datstl.Count then begin
429 endnum := datstl.Count;
430 end else if count <= 0 then begin
431 endnum := firstres + 1;
432 end else begin
433 endnum := firstres + count -1;
434 end;
435
436 for i := firstres to endnum do begin
437 if AnsiPos(FAbonString, datstl.Strings[i-1]) <> 1 then begin
438 datstl.Strings[i-1] := FAbonString + datstl.Strings[i-1];
439 end;
440 end;
441 end;
442 datstl.SaveToFile(datfilepath);
443 except
444 ret := false;
445 end;
446 finally
447 datstl.Free;
448 end;
449 Result := ret;
450 end;
451 //DAT???眼????????絅眼??==========?????障??========================================
452
453 //?????祉??絅眼??==================================================================
454 function TAbon.ReverseExecuteFile(datfilepath : String) : Boolean; //DAT???<?ゃ?????眼????????
455 var
456 datstl : TStringList;
457 i : Integer;
458 buf : String;
459 ret : Boolean;
460 begin
461 ret := true;
462 datstl := TStringList.Create;
463 try
464 try
465 datstl.LoadFromFile(datfilepath);
466 for i:=0 to datstl.Count -1 do begin
467 if AnsiPos(FAbonString, datstl.Strings[i]) = 1 then begin
468 buf := datstl.Strings[i];
469 Delete(buf,1,Length(FAbonString));
470 datstl.Strings[i] := buf;
471 end;
472 end;
473 datstl.SaveToFile(datfilepath);
474 except
475 ret := false;
476 end;
477 finally
478 datstl.Free;
479 end;
480 Result := ret;
481
482 end;
483 function TAbon.ReverseExecuteFile(datfilepath : String; resnum : Integer) : Boolean; //DAT???<?ゃ?????眼????????
484 var
485 datstl : TStringList;
486 buf : String;
487 ret : Boolean;
488 begin
489 ret := true;
490 datstl := TStringList.Create;
491 try
492 try
493 datstl.LoadFromFile(datfilepath);
494 if (resnum > 0) and (resnum <= datstl.Count) then begin
495 if AnsiPos(FAbonString, datstl.Strings[resnum-1]) = 1 then begin
496 buf := datstl.Strings[resnum-1];
497 Delete(buf,1,Length(FAbonString));
498 datstl.Strings[resnum-1] := buf;
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
510 end;
511 function TAbon.ReverseExecuteFile(datfilepath : String; firstres : Integer; count : Integer) : Boolean;//DAT???<?ゃ?????眼????????
512 var
513 datstl : TStringList;
514 i : Integer;
515 endnum : Integer; //腟?????????合??/span>
516 buf : String;
517 ret : Boolean;
518 begin
519 ret := true;
520 datstl := TStringList.Create;
521 try
522 try
523 datstl.LoadFromFile(datfilepath);
524 if (firstres > 0) and (firstres <= datstl.Count) then begin
525 if firstres + count -1 > datstl.Count then begin
526 endnum := datstl.Count;
527 end else if count <= 0 then begin
528 endnum := firstres + 1;
529 end else begin
530 endnum := firstres + count -1;
531 end;
532 for i := firstres to endnum do begin
533 if AnsiPos(FAbonString, datstl.Strings[i-1]) = 1 then begin
534 buf := datstl.Strings[i-1];
535 Delete(buf,1,Length(FAbonString));
536 datstl.Strings[i-1] := buf;
537 end;
538 end;
539 end;
540 datstl.SaveToFile(datfilepath);
541 except
542 ret := false;
543 end;
544 finally
545 datstl.Free;
546 end;
547 Result := ret;
548 end;
549 //?????祉??絅眼??=================?????障??========================================
550 //?上???祉??????????????NGword.txt??????span>
551 procedure TAbon.EditNGwords();
552 begin
553 ShellExecute(0 ,nil,PChar(FNGwordpath),nil,nil,SW_SHOW);
554 end;
555 function TAbon.CheckAbonPopupRes(line : String) :Boolean;
556 var
557 i : Integer;
558 begin
559 if FCutoffNum = 0 then begin
560 if AbonPopupRes = true then begin
561 Result := FindNGwords(line);
562 end else begin
563 Result := false;
564 end;
565 end else begin
566 if AbonPopupRes = true then begin
567 Result := FindNGwords(line);
568 if Result = false then begin
569 for i := 0 to 2 do begin
570 Delete(line,1,Ansipos('<>',line)+1);
571 end;
572 Delete(line,Ansipos('<>',line),Length(line)-Ansipos('<>',line)+1);
573 Result := Cutoff(line);
574 end;
575 end else begin
576 Result := false;
577 end;
578 end;
579 end;
580
581
582 end.
583

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