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

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