Develop and Download Open Source Software

Browse CVS Repository

Annotation of /gikonavigoeson/gikonavi/AbonUnit.pas

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


Revision 1.6 - (hide 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 h677 1.1 unit AbonUnit;
2    
3     interface
4     uses
5 h677 1.2 Windows,Messages, ShellAPI, SysUtils, Classes,StdCtrls,StrUtils;
6 h677 1.1
7     type
8     TAbon = class(TObject)
9     private
10     { Private 絎h? }
11     Froot : String;
12     FNGwordpath : String;
13 h677 1.2 Ftokens : array of array of string;
14 h677 1.1 FAbonString : String;
15 h677 1.2 FRetStrings : TStringList;
16     FCutoffNum : Integer; //?????遺札筝??g??????????怨???NG???若????????
17 h677 1.3 FDeleterlo : Boolean; //&rlo;????????
18     FReplaceul :Boolean ; //<ul>?帥?違??<br>?帥?違??舟????????
19     FReverse : Boolean ; //NG???若???с?????若?????????????荵≪????????
20     FAbonPopupRes : Boolean; //???鴻???????≪?????????????若?若????????
21     FCreateNGwordFile : Boolean; //??絎???????path??G???若??txt???<???c??????????????????????????
22 h677 1.1 procedure SetTokens(index: integer ; argline:String);
23    
24     public
25     { Public 絎h? }
26     constructor Create; // ?潟?潟?鴻????????/span>
27     destructor Destroy; override; // ???鴻????????/span>
28 h677 1.3 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 h677 1.4 property CreateNGwordFile: Boolean read FCreateNGwordFile write FCreateNGwordFile;
32 h677 1.3 property AbonString : String read FAbonString write FAbonString;
33     property AbonPopupRes : Boolean read FAbonPopupRes write FAbonPopupRes default false;
34 h677 1.1 procedure Setroot(root :String);
35     function Getroot() : String;
36     procedure SetNGwordpath(path :String);
37     function GetNGwordpath() : String;
38 h677 1.2 procedure SetCutoffNum(value : Integer);
39     function GetCutoffNum() : Integer;
40 h677 1.1 function LoadFromNGwordFile(path :String) : Boolean;
41     function ReLoadFromNGwordFile() : Boolean;
42 yoffy 1.6 procedure LoadFromStringList( bufstl : TStringList );
43 h677 1.3 function CheckAbonPopupRes(line : String) :Boolean;
44 h677 1.1 function FindNGwords(line : String) : Boolean; //1???ゃ?潟???ょ????
45 h677 1.3 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 h677 1.1 //--
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 h677 1.2 FRetStrings := TStringList.Create;
71 h677 1.4 FCreateNGwordFile := true;
72 h677 1.2 SetCutoffNum(0);
73 h677 1.1 end;
74    
75     destructor TAbon.Destroy;
76     begin
77 h677 1.2 FRetStrings.Free;
78 h677 1.1 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 yoffy 1.6 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 h677 1.3 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 h677 1.2 SetLength(Ftokens,bufstl.Count);
147 h677 1.1 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 h677 1.2 SetLength(Ftokens[index],ret);
177 h677 1.1 for i := 0 to bufstl.Count - 1 do begin
178 h677 1.2 Ftokens[index][i] := bufstl.Strings[i];
179 h677 1.1 end;
180     bufstl.Free;
181    
182     end;
183 h677 1.2 procedure TAbon.SetCutoffNum(value : Integer);
184     begin
185 h677 1.3 if value > 0 then begin
186 h677 1.2 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 h677 1.1 function TAbon.ShowAllTokens() : String;
196     var
197     i : Integer;
198     j : Integer;
199     ret : String;
200     begin
201 h677 1.2 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 h677 1.1 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 h677 1.2 for i := 0 to High(Ftokens) do begin
223 h677 1.1 hit := true;
224 h677 1.2 for j := 0 to High(Ftokens[i]) do begin
225     if AnsiPos(Ftokens[i][j],line) = 0 then begin
226 h677 1.1 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 h677 1.3 //CutOff?や札筝??????????掩?違??筝????с??????true
239     function TAbon.Cutoff(line : String) : Boolean;
240 h677 1.2 var
241     i : Integer;
242     sheed : AnsiChar;
243     buf : String;
244 h677 1.3 ret : Bool;
245 h677 1.2 begin
246 h677 1.3 ret := false;
247 h677 1.2 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 h677 1.3 ret := true;
253 h677 1.2 break;
254     end;
255     end;
256     end;
257     Result := ret;
258     end;
259 h677 1.1 //??鮎?????若???ゃ??rue??????NG???若??????????????????菴?????
260 h677 1.3 function TAbon.Execute(DestStrings : TStringList) : TStringList;
261 h677 1.1 var
262     i : Integer;
263 h677 1.5 j : Integer;
264 h677 1.2 bufline : String;
265     begin
266     FRetStrings.Clear;
267 h677 1.1
268 yoffy 1.6 //if Reverse = false then begin
269 h677 1.1 for i:=0 to DestStrings.Count - 1 do begin
270 yoffy 1.6 if FindNGwords(DestStrings.Strings[i]) <> Reverse then begin
271 h677 1.2 FRetStrings.Append(FAbonString);
272 h677 1.5 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 h677 1.1 end else begin
292 h677 1.2 bufline := DestStrings.Strings[i];
293 h677 1.3 if Deleterlo = true then begin
294 h677 1.2 bufline := AnsiReplaceText( bufline,'&rlo;','' );
295     end;
296 h677 1.3 if Replaceul = true then begin
297 h677 1.5 bufline := AnsiReplaceText( bufline,'<ul>','<br>' );
298     bufline := AnsiReplaceText( bufline,'</ul>','<br>' );
299 h677 1.2 end;
300     FRetStrings.Append(bufline);
301 h677 1.1 end;
302     end;
303 yoffy 1.6 {end else begin
304 h677 1.1 for i:=0 to DestStrings.Count - 1 do begin
305     if FindNGwords(DestStrings.Strings[i]) = false then begin
306 h677 1.5 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 h677 1.1 end else begin
327 h677 1.2 bufline := DestStrings.Strings[i];
328 h677 1.3 if Deleterlo = true then begin
329 h677 1.2 while AnsiPos('&rlo',bufline) <> 0 do begin
330     Delete(bufline,AnsiPos('&rlo',bufline),4);
331     end;
332     end;
333 h677 1.3 if Replaceul = true then begin
334 h677 1.2 bufline := AnsiReplaceText( bufline,'<ul>','<br>' );
335     bufline := AnsiReplaceText( bufline,'</ul>','<br>' );
336     end;
337     FRetStrings.Append(bufline);
338 h677 1.1 end;
339     end;
340    
341 yoffy 1.6 end;}
342 h677 1.2 Result := FRetStrings;
343 h677 1.1
344     end;
345 h677 1.3 function TAbon.Execute(DestStrings : TStringList; NGwords : TStringList) : TStringList;
346 h677 1.1 var
347     i : Integer;
348     begin
349 h677 1.2 SetLength(Ftokens,NGwords.Count);
350 h677 1.1 for i := 0 to NGwords.Count -1 do begin
351     SetTokens(i , NGwords.Strings[i]);
352     end;
353 h677 1.3 Result := Execute(DestStrings);
354 h677 1.1
355     end;
356 h677 1.3 function TAbon.Execute(DestStrings : TStringList; NGwords : TStrings) : TStringList;
357 h677 1.1 var
358     i : Integer;
359     buf : TStringList;
360     begin
361     buf := TStringList.Create;
362     buf.AddStrings(NGwords);
363 h677 1.2 SetLength(Ftokens,buf.Count);
364 h677 1.1 for i := 0 to buf.Count -1 do begin
365     SetTokens(i , buf.Strings[i]);
366     end;
367 h677 1.3 Result := Execute(DestStrings);
368 h677 1.1 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 h677 1.3 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 h677 1.1
594    
595     end.
596    

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