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.17.2.1 - (hide annotations) (download) (as text)
Mon Apr 19 22:46:48 2004 UTC (20 years ago) by yoffy
Branch: stable
Changes since 1.17: +195 -46 lines
File MIME type: text/x-pascal
・ハ゛タ 47 相当にマージ。

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 h677 1.11 TIndiviAbon = record
9     Res: Integer;
10     option: Integer; // 0:?? 1:??絽吾???若?若??
11     end;
12    
13 h677 1.1 TAbon = class(TObject)
14     private
15     { Private 絎h? }
16     Froot : String;
17 h677 1.9 Flistpath : String;
18 h677 1.1 FNGwordpath : String;
19 h677 1.2 Ftokens : array of array of string;
20 h677 1.11 FAbonRes : array of TIndiviAbon;
21 h677 1.1 FAbonString : String;
22 h677 1.2 FCutoffNum : Integer; //?????遺札筝??g??????????怨???NG???若????????
23 h677 1.17 FDeleterlo : Boolean; //&rlo;???????? //菴遵??&lro;??????
24 h677 1.3 FReplaceul :Boolean ; //<ul>?帥?違??<br>?帥?違??舟????????
25     FReverse : Boolean ; //NG???若???с?????若?????????????荵≪????????
26     FAbonPopupRes : Boolean; //???鴻???????≪?????????????若?若????????
27     FCreateNGwordFile : Boolean; //??絎???????path??G???若??txt???<???c??????????????????????????
28 h677 1.9 FNGwordFileIndex : Integer; //?上????粋昭???с??NG???若????list???茵?????
29     FNGwordname : String; //?上????粋昭???с??NG???若????;腓阪??
30 h677 1.11 FIndividualFileName : String; //???ャ???若?????????<?ゃ????
31 h677 1.16 FReturnNGwordLineNum : Boolean; //NG???若??????違??菴?????
32     FSetNGResAnchor : Boolean; //NG???綵????????????????????????鴻?吾?????鴻?≪?潟???若???ゃ????????????
33 yoffy 1.17.2.1 FDeleteSyria: Boolean; //?激???∵??????????膈?鐚?&#1792~&#1871鐚?
34 h677 1.1 procedure SetTokens(index: integer ; argline:String);
35 h677 1.9 function Getlistpath() : String;
36     procedure Setlistpath(const Value : String);
37     function LoadListFile(path :String;listStringList : TStringList) : Boolean;
38 h677 1.10 function ReadNGwordslist(line : Integer) : Boolean;
39 h677 1.11 function LoadFromSetResNumFile(SetResNumFile : String) : Boolean;
40 h677 1.1 public
41     { Public 絎h? }
42     constructor Create; // ?潟?潟?鴻????????/span>
43     destructor Destroy; override; // ???鴻????????/span>
44 h677 1.3 property Deleterlo: Boolean read FDeleterlo write FDeleterlo default false;
45     property Replaceul: Boolean read FReplaceul write FReplaceul default false;
46     property Reverse: Boolean read FReverse write FReverse default false;
47 h677 1.4 property CreateNGwordFile: Boolean read FCreateNGwordFile write FCreateNGwordFile;
48 h677 1.3 property AbonString : String read FAbonString write FAbonString;
49     property AbonPopupRes : Boolean read FAbonPopupRes write FAbonPopupRes default false;
50 h677 1.9 property listpath : String read Getlistpath write Setlistpath;
51     property NGwordFileIndex : Integer read FNGwordFileIndex write FNGwordFileIndex default 0;
52     property NGwordname : String read FNGwordname write FNGwordname;
53 h677 1.16 property ReturnNGwordLineNum : Boolean read FReturnNGwordLineNum write FReturnNGwordLineNum default false;
54     property SetNGResAnchor : Boolean read FSetNGResAnchor write FSetNGResAnchor default false;
55 yoffy 1.17.2.1 property DeleteSyria : Boolean read FDeleteSyria write FDeleteSyria default false;
56 h677 1.1 procedure Setroot(root :String);
57     function Getroot() : String;
58 h677 1.9
59     function Getfullpath(argpath : String) : String;
60 h677 1.1 procedure SetNGwordpath(path :String);
61     function GetNGwordpath() : String;
62     function LoadFromNGwordFile(path :String) : Boolean;
63     function ReLoadFromNGwordFile() : Boolean;
64 yoffy 1.6 procedure LoadFromStringList( bufstl : TStringList );
65 h677 1.3 function CheckAbonPopupRes(line : String) :Boolean;
66 h677 1.16 function FindNGwords(line : String) : Boolean; overload;//1???ゃ?潟???ょ????
67     function FindNGwords(line : String; var NGwordsLineNum : Integer) : Boolean; overload;//1???ゃ?潟???ょ????
68 yoffy 1.17.2.1 function FindNGwords(line : String; var NGwordsLineNum : Integer; var Invisible : Boolean) : Boolean; overload;//1???ゃ?潟???ょ????
69 h677 1.3 function Cutoff(line : String) : Boolean; //CutOff?や札筝??????????掩?違??筝????с??????true
70 h677 1.11 //???若????????(NG???若???с?????c???帥???潟??
71 h677 1.7 procedure Execute(var ThreadStrings : TStringList); overload;
72     procedure Execute(var ThreadStrings : TStringList; NGwords : TStringList); overload;
73     procedure Execute(var ThreadStrings : TStringList; NGwords : TStrings); overload;
74 yoffy 1.17.2.1 procedure Execute(var ResString : String; ResNumber : Integer); overload; //筝祉??lugin??????at To HTML ??/span>
75 h677 1.11 //???ャ???若??????????
76 yoffy 1.17.2.1 procedure IndividualAbon(var ThreadStrings : TStringList; SetResNumFile : String); overload;
77     procedure IndividualAbon(var ResString : String; SetResNumFile : String; ResNumber : Integer); overload;
78 h677 1.11 procedure AddIndividualAbon( ResNum : Integer ; option : Integer);
79     procedure DeleteIndividualAbon( ResNum : Integer);
80     function GetAbonResCount() : Integer;
81     function GetAbonResString(Num : Integer) : String;
82 h677 1.12 function CheckIndividualAbonList(ResNum : Integer) : Boolean;
83 h677 1.1 //--
84     function ExecuteFile(datfilepath : String; NGwordpath : String) : Boolean; overload;//DAT???<?ゃ?????眼????????
85     function ExecuteFile(datfilepath : String; resnum : Integer) : Boolean; overload; //DAT???<?ゃ?????眼????????
86     function ExecuteFile(datfilepath : String; firstres : Integer; count : Integer) : Boolean; overload; //DAT???<?ゃ?????眼????????
87     function ReverseExecuteFile(datfilepath : String) : Boolean; overload; //DAT???<?ゃ?????眼????????
88     function ReverseExecuteFile(datfilepath : String; resnum : Integer) : Boolean; overload; //DAT???<?ゃ?????眼????????
89     function ReverseExecuteFile(datfilepath : String; firstres : Integer; count : Integer) : Boolean; overload; //DAT???<?ゃ?????眼????????
90     //--
91     procedure EditNGwords(); //NGword.txt???????
92     function ShowAllTokens() : String; //???????亥??/span>
93 h677 1.9 //--
94     procedure GoHome();//List???茵?????茯???
95     function GoForward() : Boolean; //List????ゆ???G???若?????<?ゃ????茯??粋昭??
96     function GoBack() : Boolean; //List????ゅ????G???若?????<?ゃ????茯??粋昭??
97 yoffy 1.17.2.1 //--
98     function TreatSyria(AString: string): string;
99 h677 1.1 end;
100     var
101     Abon1 :TAbon;
102 h677 1.9 const
103     NGwordListFileName : String = 'NGwords.list';
104 h677 1.1
105     implementation
106    
107 yoffy 1.17.2.1 uses MojuUtils;
108    
109 h677 1.1 constructor TAbon.Create;
110     begin
111     // ??????
112     FAbonString := '&nbsp;<>&nbsp;<>&nbsp;<>&nbsp;&nbsp;<><>';
113 h677 1.4 FCreateNGwordFile := true;
114 h677 1.11 SetLength(FAbonRes,1);
115     FAbonRes[0].Res := 0;
116     FAbonRes[0].option := -1;
117    
118 h677 1.1 end;
119    
120     destructor TAbon.Destroy;
121     begin
122     inherited;
123     end;
124 h677 1.9 //root??xe\config\NGwords????????
125 h677 1.1 procedure TAbon.Setroot(root :String);
126 h677 1.9 var
127     bufStringList : TStringList;
128 h677 1.1 begin
129 h677 1.9 bufStringList := TStringList.Create;
130     try
131     if not DirectoryExists(root) then begin
132     CreateDir(root);
133     end;
134     if root[Length(root)] <> '\' then begin
135     root := root + '\';
136     end;
137     Flistpath := root + NGwordListFileName;
138     LoadListFile(Flistpath, bufStringList);
139     finally
140     bufStringList.Free;
141     end;
142 h677 1.1 Froot := root;
143     end;
144     function TAbon.Getroot() : String;
145     begin
146     Result := Froot;
147     end;
148     //NGwordpath??Gword.txt??????????/span>
149     procedure TAbon.SetNGwordpath(path :String);
150     begin
151 h677 1.9 FNGwordpath := Getfullpath(path);
152 h677 1.1 LoadFromNGwordFile(FNGwordpath);
153     end;
154     function TAbon.GetNGwordpath() : String;
155     begin
156     Result := FNGwordpath;
157     end;
158 h677 1.9 //???????鴻?с???????違???????鴻???????????
159     function TAbon.Getfullpath(argpath : String) : String;
160     begin
161     if AnsiPos(':\',argpath) <> 2 then begin //?????ゃ???????????????鴻???<??????/span>
162     if Getroot() = '' then begin
163     Result := ''; //root???鴻??荐??????????????腥冴??????
164     end else begin
165     if (Froot[Length(Froot)] = '\') and (argpath[1] = '\') then begin //????????????/span>
166     Delete(argpath,1,1);
167     end;
168     Insert( Getroot(), argpath , 1);//root???鴻???水??/span>
169     Result := argpath;
170     end;
171     end else begin
172     Result := argpath;
173     end;
174    
175     end;
176 h677 1.1 //NGword???<?ゃ??????粋昭??/span>
177     function TAbon.LoadFromNGwordFile(path :String) : boolean;
178     var
179     bufstl : TStringList;
180     begin
181 h677 1.9 path := Getfullpath(path);
182     if path = '' then begin
183     Result := false;
184     end else begin
185     bufstl := TStringList.Create;
186     try
187     try
188     bufstl.LoadFromFile(path);
189     LoadFromStringList( bufstl );
190     Result := true;
191     except
192     if CreateNGwordFile = true then begin
193     bufstl.SaveToFile(path);
194     end;
195     Result := false;
196 h677 1.1 end;
197 h677 1.9 finally
198     bufstl.Free;
199 h677 1.1 end;
200     end;
201 yoffy 1.6
202     end;
203     //NGword???鴻??茯??粋昭??/span>
204     procedure TAbon.LoadFromStringList( bufstl : TStringList );
205     var
206     i : integer;
207     begin
208     try
209 h677 1.3 for i := bufstl.Count -1 downto 0 do begin
210     if bufstl.Strings[i] = '' then begin
211     bufstl.Delete(i);
212     end;
213     end;
214 h677 1.2 SetLength(Ftokens,bufstl.Count);
215 h677 1.1 for i := 0 to bufstl.Count -1 do begin
216     SetTokens(i , bufstl.Strings[i]);
217     end;
218    
219     except
220     Exit;
221     end;
222     end;
223     //NGwordpath???≪??┃絎??????????????????????若?????∽??/span>
224     function TAbon.ReLoadFromNGwordFile() : boolean;
225     begin
226     if GetNGwordpath() ='' then begin
227     Result := false;
228     end else begin
229     Result := LoadFromNGwordFile( GetNGwordpath() );
230     end;
231     end;
232 h677 1.9 function TAbon.Getlistpath() : String;
233     begin
234     Result := Flistpath;
235     end;
236     procedure TAbon.Setlistpath(const Value : String);
237     begin
238     Flistpath := Getfullpath(Value);
239     end;
240 h677 1.1 //筝?茵???賢?????若???潟?????????????祉????
241     procedure TAbon.SetTokens(index: integer ; argline : String);
242     var
243     ret : Integer;
244     bufstl : TStringList;
245     i : Integer;
246 h677 1.14 pos : Integer;
247     buftoken : String;
248 h677 1.1 begin
249 h677 1.14 pos := 0;
250 h677 1.1 bufstl := TStringList.Create;
251 h677 1.14 try
252     if Length(argline) > 0 then begin
253     pos := AnsiPos(#9,argline);
254     while pos <> 0 DO begin
255     buftoken := Copy(argline,1,pos-1);
256     Delete(argline,1,pos);
257     if Length(buftoken) > 0 then begin
258     bufstl.Append(buftoken);
259 yoffy 1.17.2.1 end else if ( bufstl.Count = 0 ) then begin
260     bufstl.Append('');
261 h677 1.14 end;
262     pos := AnsiPos(#9,argline);
263     end;
264     if Length(argline) > 0 then begin
265     bufstl.Append(argline);
266     end;
267     ret := bufstl.Count;
268     SetLength(Ftokens[index],ret);
269     for i := 0 to bufstl.Count - 1 do begin
270     Ftokens[index][i] := bufstl.Strings[i];
271     end;
272     end;
273     finally
274     bufstl.Free;
275 h677 1.1 end;
276    
277     end;
278 h677 1.8 //Debug???<??????G???若?????障??????????
279 h677 1.1 function TAbon.ShowAllTokens() : String;
280     var
281     i : Integer;
282     j : Integer;
283     ret : String;
284     begin
285 h677 1.2 for i := 0 to High(Ftokens) do begin
286     for j := 0 to High(Ftokens[i]) do begin
287     ret := ret + Ftokens[i][j];
288 h677 1.1 end;
289     end;
290     Result := ret;
291    
292    
293    
294     end;
295    
296     //****************************************************************************//
297     //NG???若???????障????????true??菴?????
298     function TAbon.FindNGwords(line : String) : Boolean;
299     var
300 h677 1.11 lines : Integer;
301     cells : Integer;
302 h677 1.1 hit : Boolean;
303 h677 1.11 bufline : String;
304 h677 1.1 begin
305     hit := false;
306     if AnsiPos(FAbonString,line) <> 1 then begin
307 h677 1.11 for lines := 0 to High(Ftokens) do begin
308 h677 1.15 hit := true;
309     bufline := line;
310     for cells := 0 to High(Ftokens[lines]) do begin
311     if AnsiPos(Ftokens[lines][cells],bufline) = 0 then begin
312     hit := false;
313     break;
314     end else begin
315     Delete(bufline,AnsiPos(Ftokens[lines][cells],bufline),Length(Ftokens[lines][cells]));
316     end;
317     end;
318     if hit = true then begin
319     break;
320 h677 1.1 end;
321     end;
322     end;
323     Result := hit;
324 h677 1.16 end;
325     //NG???若???????障??????????true??菴?????????G???若??????違??NGwordsLineNum???ャ???????
326     function TAbon.FindNGwords(line : String; var NGwordsLineNum : Integer) : Boolean;
327     var
328     lines : Integer;
329     cells : Integer;
330     hit : Boolean;
331     bufline : String;
332     begin
333     hit := false;
334     if AnsiPos(FAbonString,line) <> 1 then begin
335     for lines := 0 to High(Ftokens) do begin
336     hit := true;
337     bufline := line;
338     for cells := 0 to High(Ftokens[lines]) do begin
339     if AnsiPos(Ftokens[lines][cells],bufline) = 0 then begin
340     hit := false;
341     break;
342     end else begin
343     Delete(bufline,AnsiPos(Ftokens[lines][cells],bufline),Length(Ftokens[lines][cells]));
344     end;
345     end;
346     if hit = true then begin
347     NGwordsLineNum := lines + 1;
348     break;
349     end;
350     end;
351     end;
352     Result := hit;
353 h677 1.1 end;
354 yoffy 1.17.2.1 //NG???若???????障??????????true??菴?????????G???若??????違??NGwordsLineNum???ャ?????????
355     //????????????若??????????????Inbisible??true?????????
356     function TAbon.FindNGwords(line : String; var NGwordsLineNum : Integer; var Invisible : Boolean) : Boolean; //1???ゃ?潟???ょ????
357     var
358     lines : Integer;
359     cells : Integer;
360     hit : Boolean;
361     bufline : String;
362     start : Integer;
363     begin
364     hit := false;
365     if AnsiPos(FAbonString,line) <> 1 then begin
366     for lines := 0 to High(Ftokens) do begin
367     hit := true;
368     bufline := line;
369     if Ftokens[lines][0] <> '' then begin
370     Invisible := false;
371     start := 0;
372     end else begin
373     Invisible := true;
374     start := 1;
375     end;
376    
377     for cells := start to High(Ftokens[lines]) do begin
378     if AnsiPos(Ftokens[lines][cells],bufline) = 0 then begin
379     hit := false;
380     break;
381     end else begin
382     Delete(bufline,AnsiPos(Ftokens[lines][cells],bufline),Length(Ftokens[lines][cells]));
383     end;
384     end;
385     if hit = true then begin
386     NGwordsLineNum := lines + 1;
387     break;
388     end;
389     end;
390     end;
391     Result := hit;
392     end;
393    
394 h677 1.3 //CutOff?や札筝??????????掩?違??筝????с??????true
395     function TAbon.Cutoff(line : String) : Boolean;
396 h677 1.2 var
397     i : Integer;
398     sheed : AnsiChar;
399     buf : String;
400 h677 1.3 ret : Bool;
401 h677 1.2 begin
402 h677 1.3 ret := false;
403 h677 1.2 if FCutoffNum <> 0 then begin
404     for i := 65 to 90 do begin
405     sheed := Chr(i);
406     buf := DupeString(sheed, FCutoffNum);
407     if AnsiContainsText(line, buf) = true then begin
408 h677 1.3 ret := true;
409 h677 1.2 break;
410     end;
411     end;
412     end;
413     Result := ret;
414     end;
415 h677 1.1 //??鮎?????若???ゃ??rue??????NG???若??????????????????菴?????
416 h677 1.7 procedure TAbon.Execute(var ThreadStrings : TStringList);
417 h677 1.1 var
418     i : Integer;
419 h677 1.16 NGwordsLine : Integer;
420 h677 1.2 bufline : String;
421 yoffy 1.17.2.1 invisi : Boolean;
422 h677 1.2 begin
423 yoffy 1.17.2.1 for i:=0 to ThreadStrings.Count - 1 do begin
424     NGwordsLine := 0;
425     if FindNGwords(ThreadStrings.Strings[i], NGwordsLine ,invisi) <> Reverse then begin
426     if invisi = true then begin
427     ThreadStrings.Strings[i] := '';
428     end else begin
429     if not ReturnNGwordLineNum and not SetNGResAnchor then begin
430     ThreadStrings.Strings[i] := FAbonString;
431     end else if not ReturnNGwordLineNum then begin
432     ThreadStrings.Strings[i] := Format('&nbsp;<>&nbsp;<>&nbsp;<>&gt;%d<><>',[(i+1)]);
433     end else if not SetNGResAnchor then begin
434     ThreadStrings.Strings[i] := Format('&nbsp;<>&nbsp;<>&nbsp;<><B> %d 茵?????G???若???????障???????障????</B><><>',[NGwordsLine]);
435     end else begin
436     ThreadStrings.Strings[i] := Format('&nbsp;<>&nbsp;<>&nbsp;<><B> %d 茵?????G???若???????障???????障????</B>&gt;%d <><>',[NGwordsLine,(i+1)]);
437     end;
438     end;
439     end else begin
440     bufline := ThreadStrings.Strings[i];
441     if Deleterlo = true then begin
442     bufline := CustomStringReplace(bufline,'&rlo;','');
443     bufline := CustomStringReplace(bufline,'&lro;','');
444     end;
445     if Replaceul = true then begin
446     bufline := CustomStringReplace( bufline,'<ul>','<br>' );
447     bufline := CustomStringReplace( bufline,'</ul>','<br>' );
448     end;
449     if DeleteSyria = true then
450     bufline := TreatSyria(bufline);
451     ThreadStrings.Strings[i] := bufline;
452     end;
453     end;
454     end;
455     procedure TAbon.Execute(var ResString : String; ResNumber : Integer);
456     var
457     NGwordsLine : Integer;
458     bufline : String;
459     invisi : Boolean;
460     begin
461     NGwordsLine := 0;
462     if FindNGwords(ResString, NGwordsLine ,invisi) <> Reverse then begin
463     if invisi = true then begin
464     ResString := '';
465     end else begin
466     if not ReturnNGwordLineNum and not SetNGResAnchor then begin
467     ResString := FAbonString;
468     end else if not ReturnNGwordLineNum then begin
469     ResString := Format('&nbsp;<>&nbsp;<>&nbsp;<>&gt;%d<><>',[(ResNumber)]);
470     end else if not SetNGResAnchor then begin
471     ResString := Format('&nbsp;<>&nbsp;<>&nbsp;<><B> %d 茵?????G???若???????障???????障????</B><><>',[NGwordsLine]);
472     end else begin
473     ResString := Format('&nbsp;<>&nbsp;<>&nbsp;<><B> %d 茵?????G???若???????障???????障????</B>&gt;%d <><>',[NGwordsLine,(ResNumber)]);
474     end;
475     end;
476 h677 1.16 end else begin
477 yoffy 1.17.2.1 bufline := ResString;
478     if Deleterlo = true then begin
479     bufline := CustomStringReplace( bufline,'&rlo;','' );
480     bufline := CustomStringReplace( bufline,'&lro;','' );
481     end;
482     if Replaceul = true then begin
483     bufline := CustomStringReplace( bufline,'<ul>','<br>' );
484     bufline := CustomStringReplace( bufline,'</ul>','<br>' );
485     end;
486     if DeleteSyria = true then
487     bufline := TreatSyria(bufline);
488     ResString := bufline;
489 h677 1.7 end;
490 h677 1.1 end;
491 yoffy 1.17.2.1
492 h677 1.7 procedure TAbon.Execute(var ThreadStrings : TStringList; NGwords : TStringList);
493 h677 1.1 var
494     i : Integer;
495     begin
496 h677 1.2 SetLength(Ftokens,NGwords.Count);
497 h677 1.1 for i := 0 to NGwords.Count -1 do begin
498     SetTokens(i , NGwords.Strings[i]);
499     end;
500 h677 1.7 Execute(ThreadStrings);
501 h677 1.1
502     end;
503 h677 1.7 procedure TAbon.Execute(var ThreadStrings : TStringList; NGwords : TStrings);
504 h677 1.1 var
505     i : Integer;
506     buf : TStringList;
507     begin
508     buf := TStringList.Create;
509     buf.AddStrings(NGwords);
510 h677 1.2 SetLength(Ftokens,buf.Count);
511 h677 1.1 for i := 0 to buf.Count -1 do begin
512     SetTokens(i , buf.Strings[i]);
513     end;
514 h677 1.7 Execute(ThreadStrings);
515 h677 1.1 buf.Free;
516     end;
517    
518    
519     //****************************************************************************//
520     //DAT???眼????????絅眼??===========================================================
521     //NG???若???????????鴻???????????若?若?????水??/span>
522     function TAbon.ExecuteFile(datfilepath : String; NGwordpath : String) : Boolean; //DAT???<?ゃ?????眼????????
523     var
524     datstl : TStringList;
525     ret : Boolean;
526     i : Integer;
527     begin
528     datstl := TStringList.Create;
529     ret := true;
530     try
531     try
532     datstl.LoadFromFile(datfilepath);
533     for i := 0 to datstl.Count -1 do begin
534     if FindNGwords(datstl.Strings[i]) = true then begin
535     datstl.Strings[i] := FAbonString + datstl.Strings[i]
536     end;
537     end;
538    
539     datstl.SaveToFile(datfilepath);
540     except
541     ret := false;
542     end;
543     finally
544     datstl.Free;
545     end;
546     Result := ret;
547    
548     end;
549     //??絎??????????合?????????????若?若???水??/span>
550     function TAbon.ExecuteFile(datfilepath : String; resnum : Integer) : Boolean; //DAT???<?ゃ?????眼????????
551     var
552     datstl : TStringList;
553     ret : Boolean;
554     begin
555     ret := true;
556     datstl := TStringList.Create;
557     try
558     try
559     datstl.LoadFromFile(datfilepath);
560     if (resnum > 0) and (resnum <= datstl.Count) then begin
561     if AnsiPos(FAbonString, datstl.Strings[resnum-1]) <> 1 then begin
562     datstl.Strings[resnum-1] := FAbonString + datstl.Strings[resnum-1];
563     end;
564     end;
565     datstl.SaveToFile(datfilepath);
566     except
567     ret := false;
568     end;
569     finally
570     datstl.Free;
571     end;
572     Result := ret;
573     end;
574     //firstres????count???????鴻???????????若?若???水??/span>
575     function TAbon.ExecuteFile(datfilepath : String; firstres : Integer; count : Integer) : Boolean; //DAT???<?ゃ?????眼????????
576     var
577     datstl : TStringList;
578     i : Integer;
579     endnum : Integer; //腟?????????合??/span>
580     ret : Boolean;
581     begin
582     ret := true;
583     datstl := TStringList.Create;
584     try
585     try
586     datstl.LoadFromFile(datfilepath);
587     if (firstres > 0) and (firstres <= datstl.Count) then begin
588     if firstres + count -1 > datstl.Count then begin
589     endnum := datstl.Count;
590     end else if count <= 0 then begin
591     endnum := firstres + 1;
592     end else begin
593     endnum := firstres + count -1;
594     end;
595    
596     for i := firstres to endnum do begin
597     if AnsiPos(FAbonString, datstl.Strings[i-1]) <> 1 then begin
598     datstl.Strings[i-1] := FAbonString + datstl.Strings[i-1];
599     end;
600     end;
601     end;
602     datstl.SaveToFile(datfilepath);
603     except
604     ret := false;
605     end;
606     finally
607     datstl.Free;
608     end;
609     Result := ret;
610     end;
611     //DAT???眼????????絅眼??==========?????障??========================================
612    
613     //?????祉??絅眼??==================================================================
614     function TAbon.ReverseExecuteFile(datfilepath : String) : Boolean; //DAT???<?ゃ?????眼????????
615     var
616     datstl : TStringList;
617     i : Integer;
618     buf : String;
619     ret : Boolean;
620     begin
621     ret := true;
622     datstl := TStringList.Create;
623     try
624     try
625     datstl.LoadFromFile(datfilepath);
626     for i:=0 to datstl.Count -1 do begin
627     if AnsiPos(FAbonString, datstl.Strings[i]) = 1 then begin
628     buf := datstl.Strings[i];
629     Delete(buf,1,Length(FAbonString));
630     datstl.Strings[i] := buf;
631     end;
632     end;
633     datstl.SaveToFile(datfilepath);
634     except
635     ret := false;
636     end;
637     finally
638     datstl.Free;
639     end;
640     Result := ret;
641    
642     end;
643     function TAbon.ReverseExecuteFile(datfilepath : String; resnum : Integer) : Boolean; //DAT???<?ゃ?????眼????????
644     var
645     datstl : TStringList;
646     buf : String;
647     ret : Boolean;
648     begin
649     ret := true;
650     datstl := TStringList.Create;
651     try
652     try
653     datstl.LoadFromFile(datfilepath);
654     if (resnum > 0) and (resnum <= datstl.Count) then begin
655     if AnsiPos(FAbonString, datstl.Strings[resnum-1]) = 1 then begin
656     buf := datstl.Strings[resnum-1];
657     Delete(buf,1,Length(FAbonString));
658     datstl.Strings[resnum-1] := buf;
659     end;
660     end;
661     datstl.SaveToFile(datfilepath);
662     except
663     ret := false;
664     end;
665     finally
666     datstl.Free;
667     end;
668     Result := ret;
669    
670     end;
671     function TAbon.ReverseExecuteFile(datfilepath : String; firstres : Integer; count : Integer) : Boolean;//DAT???<?ゃ?????眼????????
672     var
673     datstl : TStringList;
674     i : Integer;
675     endnum : Integer; //腟?????????合??/span>
676     buf : String;
677     ret : Boolean;
678     begin
679     ret := true;
680     datstl := TStringList.Create;
681     try
682     try
683     datstl.LoadFromFile(datfilepath);
684     if (firstres > 0) and (firstres <= datstl.Count) then begin
685     if firstres + count -1 > datstl.Count then begin
686     endnum := datstl.Count;
687     end else if count <= 0 then begin
688     endnum := firstres + 1;
689     end else begin
690     endnum := firstres + count -1;
691     end;
692     for i := firstres to endnum do begin
693     if AnsiPos(FAbonString, datstl.Strings[i-1]) = 1 then begin
694     buf := datstl.Strings[i-1];
695     Delete(buf,1,Length(FAbonString));
696     datstl.Strings[i-1] := buf;
697     end;
698     end;
699     end;
700     datstl.SaveToFile(datfilepath);
701     except
702     ret := false;
703     end;
704     finally
705     datstl.Free;
706     end;
707     Result := ret;
708     end;
709     //?????祉??絅眼??=================?????障??========================================
710     //?上???祉??????????????NGword.txt??????span>
711     procedure TAbon.EditNGwords();
712     begin
713     ShellExecute(0 ,nil,PChar(FNGwordpath),nil,nil,SW_SHOW);
714     end;
715 h677 1.12 //???????≪???????ゅ??∽??/span>
716 h677 1.3 function TAbon.CheckAbonPopupRes(line : String) :Boolean;
717 h677 1.9 begin
718     if AbonPopupRes = true then begin
719     Result := FindNGwords(line);
720     end else begin
721     Result := false;
722     end;
723     end;
724 h677 1.10 //茲??違??G???若???????鴻????茯??粋昭??==============================================
725 h677 1.9 //List???<?ゃ????茯??粋昭??
726     function TAbon.LoadListFile(path :String; listStringList : TStringList) : Boolean;
727     begin
728     try
729     listStringList.LoadFromFile(path);
730     Result := true;
731     except
732     listStringList.Append('筝???NGword.txt');
733     listStringList.SaveToFile(path);
734     Result := false;
735     end;
736     end;
737     //List????ゆ???G???若?????<?ゃ????茯??粋昭??
738     function TAbon.GoForward() : Boolean;
739 h677 1.10 begin
740     FNGwordFileIndex := FNGwordFileIndex + 1;
741     Result := ReadNGwordslist(FNGwordFileIndex);
742     end;
743     //List????ゅ????G???若?????<?ゃ????茯??粋昭??
744     function TAbon.GoBack() : Boolean;
745     begin
746     FNGwordFileIndex := FNGwordFileIndex -1;
747     Result := ReadNGwordslist(FNGwordFileIndex);
748     end;
749     //List???茵?????茯???
750     procedure TAbon.GoHome();
751     begin
752     FNGwordFileIndex := 0;
753     ReadNGwordslist(FNGwordFileIndex);
754     end;
755     //List??ine茵?????茯???
756     function TAbon.ReadNGwordslist(line : Integer) : Boolean;
757 h677 1.3 var
758 h677 1.9 liststl : TStringList;
759     linebuf : String;
760 h677 1.3 begin
761 h677 1.9 liststl := TStringList.Create;
762     try
763     if LoadListFile(Flistpath,liststl) = true then begin
764 h677 1.10 if line < 0 then begin
765     line := liststl.Count - 1;
766     FNGwordFileIndex := liststl.Count - 1;
767     end else if line > liststl.Count - 1 then begin
768     line := 0;
769 h677 1.9 FNGwordFileIndex := 0;
770     end;
771 h677 1.10 linebuf := liststl.Strings[line];
772 h677 1.9 FNGwordname := Copy(linebuf,1,AnsiPos('=',linebuf)-1);
773     Delete(linebuf,1,AnsiPos('=',linebuf));
774     SetNGwordpath(linebuf);
775     Result := true;
776 h677 1.3 end else begin
777     Result := false;
778 h677 1.9 end
779     finally
780     liststl.Free;
781 h677 1.3 end;
782 h677 1.9
783     end;
784 h677 1.10 //茲??違??G???若???????鴻????茯??粋昭??=====?????障??================================
785 h677 1.11 //???ャ???若????絎?茵??∽??/span>
786     procedure TAbon.IndividualAbon(var ThreadStrings : TStringList; SetResNumFile : String);
787     var
788     i : Integer;
789     begin
790     if FileExists(SetResNumFile) = true then begin
791     if LoadFromSetResNumFile(SetResNumFile) = true then begin
792     for i := 0 to High(FAbonRes) do begin
793     if (FAbonRes[i].Res <= ThreadStrings.Count) and (FAbonRes[i].Res > 0) then begin
794     if FAbonRes[i].option = 0 then begin
795     ThreadStrings.Strings[FAbonRes[i].Res-1] := '';
796     end else begin
797 hi_ 1.13 ThreadStrings.Strings[FAbonRes[i].Res-1] := '???若????<>???若????<>???若????<>???若????<>';
798 h677 1.11 end;
799     end;
800    
801     end;
802     end;
803     end else begin
804     FIndividualFileName := SetResNumFile;
805     SetLength(FAbonRes,1);
806     FAbonRes[0].Res := 0;
807     FAbonRes[0].option := -1;
808     end;
809     end;
810 yoffy 1.17.2.1 procedure TAbon.IndividualAbon(var ResString : String; SetResNumFile : String; ResNumber : Integer);
811     var
812     i : Integer;
813     begin
814     if FileExists(SetResNumFile) = true then begin
815     if LoadFromSetResNumFile(SetResNumFile) = true then begin
816     for i := 0 to High(FAbonRes) do begin
817     if FAbonRes[i].Res = ResNumber then begin
818     if FAbonRes[i].option = 0 then begin
819     ResString := '';
820     end else begin
821     ResString := '???若????<>???若????<>???若????<>???若????<>';
822     end;
823     Exit;
824     end;
825     end;
826     end;
827     end else begin
828     FIndividualFileName := SetResNumFile;
829     SetLength(FAbonRes,1);
830     FAbonRes[0].Res := 0;
831     FAbonRes[0].option := -1;
832     end;
833     end;
834    
835 h677 1.11 //???ャ???若???????<?ゃ????粋昭?翠?∽??/span>
836     function TAbon.LoadFromSetResNumFile(SetResNumFile : String) : Boolean;
837     var
838     bufStringList : TStringList;
839     bufLine : String;
840     i : Integer;
841     begin
842     bufStringList := TStringList.Create;
843     try
844     try
845     bufStringList.LoadFromFile(SetResNumFile);
846     FIndividualFileName := SetResNumFile;
847     //腥肴?????/span>
848     for i := bufStringList.Count-1 downto 0 do begin
849     if bufStringList.Strings[i] = '' then begin
850     bufStringList.Delete(i);
851     end;
852     end;
853    
854     //?<?≪??∈篆?
855     SetLength(FAbonRes,bufStringList.Count);
856     //篁e??/span>
857     for i :=0 to bufStringList.Count - 1 do begin
858     bufLine := Trim(bufStringList.Strings[i]);
859     FAbonRes[i].Res := StrToInt(Copy(bufLine,1,AnsiPos('-',bufLine)-1));
860     FAbonRes[i].option := StrToInt(Copy(bufLine,AnsiPos('-',bufLine)+1,1));
861     end;
862     except
863     Result := false;
864     Exit;
865     end;
866     finally
867     bufStringList.Free;
868     end;
869     Result := true;
870     end;
871     //???ャ???若???????<?ゃ????申??
872     procedure TAbon.AddIndividualAbon( ResNum : Integer ; option : Integer);
873     var
874     IndividualFile : TStringList;
875     linebuf : String;
876     i : Integer;
877     begin
878     IndividualFile := TStringList.Create;
879     if FAbonRes[0].Res <> 0 then begin
880     for i := 0 to High(FAbonRes) do begin
881     if FAbonRes[i].Res <> ResNum then begin
882     linebuf := IntToStr(FAbonRes[i].Res) + '-' + IntToStr(FabonRes[i].option);
883     IndividualFile.Append(linebuf);
884     end;
885     end;
886     end;
887     linebuf := IntToStr(ResNum) + '-' + IntToStr(option);
888     IndividualFile.Append(linebuf);
889     try
890     IndividualFile.SaveToFile(FIndividualFileName);
891     finally
892     IndividualFile.Free;
893     end;
894     end;
895     //???ャ???若???????<?ゃ??????????/span>
896     procedure TAbon.DeleteIndividualAbon( ResNum : Integer);
897     var
898     IndividualFile : TStringList;
899     linebuf : String;
900     i : Integer;
901     begin
902     IndividualFile := TStringList.Create;
903     if FAbonRes[0].Res <> 0 then begin
904     for i := 0 to High(FAbonRes) do begin
905     if FAbonRes[i].Res <> ResNum then begin
906     linebuf := IntToStr(FAbonRes[i].Res) + '-' + IntToStr(FabonRes[i].option);
907     IndividualFile.Append(linebuf);
908     end;
909     end;
910     end;
911     if IndividualFile.Count <> 0 then begin
912     try
913     IndividualFile.SaveToFile(FIndividualFileName);
914     finally
915     IndividualFile.Free;
916     end;
917     end else begin
918     if FileExists(FIndividualFileName) = true then begin
919     DeleteFile(FIndividualFileName);
920     end;
921     end;
922     end;
923     //???ャ???若?????????鴻???????違??菴???
924     function TAbon.GetAbonResCount() : Integer;
925 h677 1.12 var
926     i : Integer;
927 h677 1.11 begin
928 h677 1.12 if FAbonRes[0].Res = 0 then begin
929     Result := 0
930     end else begin
931     i := High(FAbonRes);
932     Result := i+1;
933     end;
934 h677 1.11 end;
935     //???ャ???若?????????鴻?????茵????????鴻????絖????ц???
936     function TAbon.GetAbonResString(Num : Integer) : String;
937     begin
938 h677 1.12 if (Num <= High(FAbonRes)) and (Num >= 0) then begin
939 h677 1.11 Result := IntToStr(FAbonRes[Num].Res);
940     end else begin
941     Result := '';
942     end;
943 h677 1.12 end;
944     //???????≪???????ゅ???/span>
945     function TAbon.CheckIndividualAbonList(ResNum : Integer) : Boolean;
946     var
947     i : Integer;
948     begin
949     if FAbonRes[0].Res <> 0 then begin
950     for i := 0 to High(FAbonRes) do begin
951     if FAbonRes[i].Res = ResNum then begin
952     Result := true;
953     Exit;
954     end;
955     end;
956     end;
957     Result := false;
958 yoffy 1.17.2.1
959     end;
960     //?激???∵??????????膈?
961     function TAbon.TreatSyria(AString: string): string;
962     var
963     //count: Integer; //(&#1792~&#1871)
964     pos: Integer;
965     tmp: string;
966     begin
967     pos := AnsiPos('&#18', AString);
968     while pos <> 0 do begin
969     if AString[pos+6] = ';' then begin
970     if StrToIntDef(Copy(AString, pos+4, 2), 0) <= 71 then begin
971     tmp := tmp + Copy(AString, 1, pos - 1);
972     Delete(AString, 1, pos+6);
973     end else begin
974     tmp := tmp + Copy(AString, 1, pos + 6);
975     Delete(AString, 1, pos+6);
976     end;
977     end else begin
978     tmp := tmp + Copy(AString, 1, pos + 3);
979     Delete(AString, 1, pos+3);
980     end;
981     pos := AnsiPos('&#18', AString);
982     end;
983     if Length(AString) > 0 then
984     tmp := tmp + AString;
985     AString := tmp;
986     tmp := '';
987    
988     pos := AnsiPos('&#179', AString);
989     while pos <> 0 do begin
990     if AString[pos+6] = ';' then begin
991     if StrToIntDef(Copy(AString, pos+5, 1), 0) > 2 then begin
992     tmp := tmp + Copy(AString, 1, pos - 1);
993     Delete(AString, 1, pos+6);
994     end else begin
995     tmp := tmp + Copy(AString, 1, pos + 6);
996     Delete(AString, 1, pos+6);
997     end;
998     tmp := tmp + Copy(AString, 1, pos - 1);
999     Delete(AString, 1, pos+6);
1000     end else begin
1001     tmp := tmp + Copy(AString, 1, pos + 4);
1002     Delete(AString, 1, pos+4);
1003     end;
1004     pos := AnsiPos('&#179', AString);
1005     end;
1006     if Length(AString) > 0 then
1007     tmp := tmp + AString;
1008     Result := tmp;
1009 h677 1.11 end;
1010 h677 1.1 end.
1011    

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