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.25 - (hide annotations) (download) (as text)
Wed May 19 15:07:09 2004 UTC (19 years, 11 months ago) by h677
Branch: MAIN
CVS Tags: v1_48_0_510
Changes since 1.24: +1 -1 lines
File MIME type: text/x-pascal
高速タブ切り替えができるように、スレごとにブラウザをつくるように変更

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

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