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.3 - (hide 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 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     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 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 h677 1.3 function CheckAbonPopupRes(line : String) :Boolean;
43 h677 1.1 function FindNGwords(line : String) : Boolean; //1???ゃ?潟???ょ????
44 h677 1.3 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 h677 1.1 //--
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 h677 1.2 FRetStrings := TStringList.Create;
70     SetCutoffNum(0);
71 h677 1.1 end;
72    
73     destructor TAbon.Destroy;
74     begin
75 h677 1.2 FRetStrings.Free;
76 h677 1.1 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 h677 1.3 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 h677 1.2 SetLength(Ftokens,bufstl.Count);
126 h677 1.1 for i := 0 to bufstl.Count -1 do begin
127     SetTokens(i , bufstl.Strings[i]);
128     end;
129    
130     except
131 h677 1.3 if CreateNGwordFile = true then begin
132     bufstl.LoadFromFile(path);
133     end;
134 h677 1.1 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 h677 1.2 SetLength(Ftokens[index],ret);
163 h677 1.1 for i := 0 to bufstl.Count - 1 do begin
164 h677 1.2 Ftokens[index][i] := bufstl.Strings[i];
165 h677 1.1 end;
166     bufstl.Free;
167    
168     end;
169 h677 1.2 procedure TAbon.SetCutoffNum(value : Integer);
170     begin
171 h677 1.3 if value > 0 then begin
172 h677 1.2 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 h677 1.1 function TAbon.ShowAllTokens() : String;
182     var
183     i : Integer;
184     j : Integer;
185     ret : String;
186     begin
187 h677 1.2 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 h677 1.1 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 h677 1.2 for i := 0 to High(Ftokens) do begin
209 h677 1.1 hit := true;
210 h677 1.2 for j := 0 to High(Ftokens[i]) do begin
211     if AnsiPos(Ftokens[i][j],line) = 0 then begin
212 h677 1.1 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 h677 1.3 //CutOff?や札筝??????????掩?違??筝????с??????true
225     function TAbon.Cutoff(line : String) : Boolean;
226 h677 1.2 var
227     i : Integer;
228     sheed : AnsiChar;
229     buf : String;
230 h677 1.3 ret : Bool;
231 h677 1.2 begin
232 h677 1.3 ret := false;
233 h677 1.2 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 h677 1.3 ret := true;
239 h677 1.2 break;
240     end;
241     end;
242     end;
243     Result := ret;
244     end;
245 h677 1.1 //??鮎?????若???ゃ??rue??????NG???若??????????????????菴?????
246 h677 1.3 function TAbon.Execute(DestStrings : TStringList) : TStringList;
247 h677 1.1 var
248     i : Integer;
249 h677 1.2 bufline : String;
250     begin
251     FRetStrings.Clear;
252 h677 1.1
253 h677 1.3 if Reverse = false then begin
254 h677 1.1 for i:=0 to DestStrings.Count - 1 do begin
255 h677 1.2 if FindNGwords(DestStrings.Strings[i]) = true then begin
256     FRetStrings.Append(FAbonString);
257 h677 1.1 end else begin
258 h677 1.2 bufline := DestStrings.Strings[i];
259 h677 1.3 if Deleterlo = true then begin
260 h677 1.2 bufline := AnsiReplaceText( bufline,'&rlo;','' );
261     end;
262 h677 1.3 if Replaceul = true then begin
263 h677 1.2 bufline := AnsiReplaceText( bufline,'<ul>','<br>' );
264     bufline := AnsiReplaceText( bufline,'</ul>','<br>' );
265     end;
266     FRetStrings.Append(bufline);
267 h677 1.1 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 h677 1.2 FRetStrings.Append(FAbonString);
273 h677 1.1 end else begin
274 h677 1.2 bufline := DestStrings.Strings[i];
275 h677 1.3 if Deleterlo = true then begin
276 h677 1.2 while AnsiPos('&rlo',bufline) <> 0 do begin
277     Delete(bufline,AnsiPos('&rlo',bufline),4);
278     end;
279     end;
280 h677 1.3 if Replaceul = true then begin
281 h677 1.2 bufline := AnsiReplaceText( bufline,'<ul>','<br>' );
282     bufline := AnsiReplaceText( bufline,'</ul>','<br>' );
283     end;
284     FRetStrings.Append(bufline);
285 h677 1.1 end;
286     end;
287    
288     end;
289 h677 1.2 Result := FRetStrings;
290 h677 1.1
291     end;
292 h677 1.3 function TAbon.Execute(DestStrings : TStringList; NGwords : TStringList) : TStringList;
293 h677 1.1 var
294     i : Integer;
295     begin
296 h677 1.2 SetLength(Ftokens,NGwords.Count);
297 h677 1.1 for i := 0 to NGwords.Count -1 do begin
298     SetTokens(i , NGwords.Strings[i]);
299     end;
300 h677 1.3 Result := Execute(DestStrings);
301 h677 1.1
302     end;
303 h677 1.3 function TAbon.Execute(DestStrings : TStringList; NGwords : TStrings) : TStringList;
304 h677 1.1 var
305     i : Integer;
306     buf : TStringList;
307     begin
308     buf := TStringList.Create;
309     buf.AddStrings(NGwords);
310 h677 1.2 SetLength(Ftokens,buf.Count);
311 h677 1.1 for i := 0 to buf.Count -1 do begin
312     SetTokens(i , buf.Strings[i]);
313     end;
314 h677 1.3 Result := Execute(DestStrings);
315 h677 1.1 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 h677 1.3 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 h677 1.1
541    
542     end.
543    

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