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

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