Develop and Download Open Source Software

Browse CVS Repository

Annotation of /gikonavigoeson/gikonavi/RoundData.pas

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.4 - (hide annotations) (download) (as text)
Tue Dec 9 14:06:07 2003 UTC (20 years, 4 months ago) by h677
Branch: MAIN
Changes since 1.3: +133 -0 lines
File MIME type: text/x-pascal
バタ44以前の巡回ファイルのコンバーターを作った。 

1 hi_ 1.1 unit RoundData;
2    
3     interface
4    
5     uses
6     Windows, Messages, SysUtils, Classes,
7     GikoSystem, BoardGroup;
8    
9     type
10     TGikoRoundType = (grtBoard, grtItem);
11     TRoundItem = class;
12    
13     TRoundList = class(TObject)
14     private
15     FBoardList: TList;
16     FItemList: TList;
17     function GetCount(RoundType: TGikoRoundType): Integer;
18     function GetRoundItem(Index: Integer; RoundType: TGikoRoundType): TRoundItem;
19     function ParseRoundLine(Line: string; RoundType: TGikoRoundType): TRoundItem;
20 h677 1.4 function ParseOldRoundLine(Line: string; RoundType: TGikoRoundType): TRoundItem;
21 hi_ 1.1 public
22     RoundNameList: TStringList;
23    
24     constructor Create;
25     destructor Destroy; override;
26     function Add(Board: TBoard): Integer; overload;
27     function Add(ThreadItem: TThreadItem): Integer; overload;
28     procedure Delete(Board: TBoard); overload;
29     procedure Delete(ThreadItem: TThreadItem); overload;
30     procedure Clear;
31     function Find(Board: TBoard): Integer; overload;
32     function Find(ThreadItem: TThreadItem): Integer; overload;
33     property Count[RoundType: TGikoRoundType]: Integer read GetCount;
34     property Items[Index: integer; RoundType: TGikoRoundType]: TRoundItem read GetRoundItem;
35     procedure SetRoundName(Board: TBoard; RoundName: string); overload;
36     procedure SetRoundName(ThreadItem: TThreadItem; RoundName: string); overload;
37    
38 h677 1.4 procedure ConvertRoundFile; //bata44鐃緒申鐃?鐃緒申Roundfile鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申
39 hi_ 1.1 procedure LoadRoundFile;
40     procedure SaveRoundFile;
41     end;
42    
43     TRoundItem = class(TObject)
44     private
45     // FBBSType: TGikoBBSType;
46     FRoundName: string;
47     FRoundType: TGikoRoundType;
48 yoffy 1.3 FItem : TObject;
49     FURL : string;
50 hi_ 1.1 FBoardTitle: string;
51     FThreadTitle: string;
52     FFileName: string;
53     FBoolData: Boolean; //鐃緒申鐃緒申鐃緒申鐃緒申鐃?鐃緒申鐃緒申鐃緒申
54     public
55     // property BBSType: TGikoBBSType read FBBSType write FBBSType;
56     property RoundName: string read FRoundName write FRoundName;
57     property RoundType: TGikoRoundType read FRoundType write FRoundType;
58 yoffy 1.3 property Item : TObject read FItem write FItem;
59     property URL : string read FURL write FURL;
60 hi_ 1.1 property BoardTitle: string read FBoardTitle write FBoardTitle;
61     property ThreadTitle: string read FThreadTitle write FThreadTitle;
62     property FileName: string read FFileName write FFileName;
63     property BoolData: Boolean read FBoolData write FBoolData;
64     end;
65    
66     var
67     RoundList: TRoundList;
68    
69     implementation
70     const
71     ROUND_BOARD_FILENAME: string = 'RoundBoard.2ch'; //鐃緒申鐃緒申鐃緒申BoardGroup鐃緒申鐃緒申鐃緒申
72     ROUND_ITEM_FILENAME: string = 'RoundItem.2ch'; //鐃緒申鐃緒申
73     ROUND_INDEX_VERSION: string = '1.00';
74    
75     constructor TRoundList.Create;
76     begin
77     inherited;
78     FBoardList := TList.Create;
79     FItemList := TList.Create;
80     RoundNameList := TStringList.Create;
81     RoundNameList.Sorted := True;
82     RoundNameList.Duplicates := dupIgnore;
83     end;
84    
85     destructor TRoundList.Destroy;
86     begin
87     RoundNameList.Free;
88     Clear;
89     FBoardList.Free;
90     FItemList.Free;
91     inherited;
92     end;
93    
94     function TRoundList.Add(Board: TBoard): Integer;
95     var
96     idx: Integer;
97     Item: TRoundItem;
98     begin
99 h677 1.2 Result := -1;
100 hi_ 1.1 idx := Find(Board);
101     if idx = -1 then begin
102     Item := TRoundItem.Create;
103     // Item.BBSType := gbt2ch; //鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申
104     Item.RoundType := grtBoard;
105 yoffy 1.3 Item.Item := Board;
106 hi_ 1.1 Item.BoardTitle := Board.Title;
107     Item.ThreadTitle := '';
108     Item.FileName := '';
109     Item.RoundName := Board.RoundName;
110 h677 1.2 Result := FBoardList.Add(Item);
111 hi_ 1.1 end;
112     end;
113    
114     function TRoundList.Add(ThreadItem: TThreadItem): Integer;
115     var
116     idx: Integer;
117     Item: TRoundItem;
118     begin
119 h677 1.2 Result := -1;
120 hi_ 1.1 idx := Find(ThreadItem);
121     if idx = -1 then begin
122     Item := TRoundItem.Create;
123     // Item.BBSType := gbt2ch; //鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申
124     Item.RoundType := grtItem;
125 yoffy 1.3 Item.Item := ThreadItem;
126 h677 1.4 Item.URL := Threaditem.URL;
127 hi_ 1.1 Item.BoardTitle := ThreadItem.ParentBoard.Title;
128     Item.ThreadTitle := ThreadItem.Title;
129     Item.FileName := ThreadItem.FileName;
130     Item.RoundName := ThreadItem.RoundName;
131 h677 1.2 Result := FItemList.Add(Item);
132 hi_ 1.1 end;
133     end;
134    
135     procedure TRoundList.Delete(Board: TBoard);
136     var
137     idx: Integer;
138     Item: TRoundItem;
139     begin
140     idx := Find(Board);
141     if idx <> -1 then begin
142     Item := TRoundItem(FBoardList[idx]);
143     Item.Free;
144     FBoardList.Delete(idx);
145     end;
146     end;
147    
148     procedure TRoundList.Delete(ThreadItem: TThreadItem);
149     var
150     idx: Integer;
151     Item: TRoundItem;
152     begin
153     idx := Find(ThreadItem);
154     if idx <> -1 then begin
155     Item := TRoundItem(FItemList[idx]);
156     Item.Free;
157     FItemList.Delete(idx);
158     end;
159     end;
160    
161     procedure TRoundList.Clear;
162     var
163     i: Integer;
164     begin
165     for i := FBoardList.Count - 1 downto 0 do begin
166     TRoundItem(FBoardList[i]).Free;
167     FBoardList.Delete(i);
168     end;
169     for i := FItemList.Count - 1 downto 0 do begin
170     TRoundItem(FItemList[i]).Free;
171     FItemList.Delete(i);
172     end;
173     end;
174    
175     function TRoundList.Find(Board: TBoard): Integer;
176     var
177     i: Integer;
178     Item: TRoundItem;
179     begin
180     Result := -1;
181     for i := 0 to FBoardList.Count - 1 do begin
182     Item := TRoundItem(FBoardList[i]);
183     if Item.FRoundType <> grtBoard then Continue;
184 yoffy 1.3 if Item.Item = Board then begin
185 hi_ 1.1 Result := i;
186     Exit;
187     end;
188     end;
189     end;
190    
191     function TRoundList.Find(ThreadItem: TThreadItem): Integer;
192     var
193     i: Integer;
194     Item: TRoundItem;
195     begin
196     Result := -1;
197     for i := 0 to FItemList.Count - 1 do begin
198     Item := TRoundItem(FItemList[i]);
199     if Item.FRoundType <> grtItem then Continue;
200 yoffy 1.3 if Item.Item = ThreadItem then begin
201 hi_ 1.1 Result := i;
202     Exit;
203     end;
204     end;
205     end;
206    
207     procedure TRoundList.SetRoundName(Board: TBoard; RoundName: string);
208     var
209     idx: Integer;
210     Item: TRoundItem;
211     begin
212     idx := Find(Board);
213     if idx <> -1 then begin
214     Item := TRoundItem(FBoardList[idx]);
215     Item.RoundName := RoundName;
216     end;
217     end;
218    
219     procedure TRoundList.SetRoundName(ThreadItem: TThreadItem; RoundName: string);
220     var
221     idx: Integer;
222     Item: TRoundItem;
223     begin
224     idx := Find(ThreadItem);
225     if idx <> -1 then begin
226     Item := TRoundItem(FItemList[idx]);
227     Item.RoundName := RoundName;
228     end;
229     end;
230    
231     function TRoundList.GetCount(RoundType: TGikoRoundType): Integer;
232     begin
233     Result := 0;
234     if RoundType = grtBoard then
235     Result := FBoardList.Count
236     else if RoundType = grtItem then
237     Result := FItemList.Count;
238     end;
239    
240     function TRoundList.GetRoundItem(Index: Integer; RoundType: TGikoRoundType): TRoundItem;
241     begin
242     Result := nil;
243     if RoundType = grtBoard then begin
244     if (Index >= 0) and (Index < FBoardList.Count) then
245     Result := TRoundItem(FBoardList[Index]);
246     end else if RoundType = grtItem then begin
247     if (Index >= 0) and (Index < FItemList.Count) then
248     Result := TRoundItem(FItemList[Index]);
249     end;
250     end;
251    
252     procedure TRoundList.LoadRoundFile;
253     var
254     i: Integer;
255     sl: TStringList;
256     FileName: string;
257     Item: TRoundItem;
258     begin
259     sl := TStringList.Create;
260     try
261     //鐃?鐃?鐃?鐃緒申鐃緒申鐃?鐃?鐃?鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申
262     FileName := GikoSys.GetConfigDir + ROUND_BOARD_FILENAME;
263     if FileExists(FileName) then begin
264     sl.LoadFromFile(FileName);
265     //鐃?鐃?鐃緒申鐃緒申鐃?鐃?鐃?鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申
266     for i := 1 to sl.Count - 1 do begin
267     Item := ParseRoundLine(sl[i], grtBoard);
268     FBoardList.Add(Item);
269     RoundNameList.Add(Item.RoundName);
270     end;
271     end;
272     //鐃?鐃緒申鐃緒申鐃緒申鐃?鐃?鐃?鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申
273     FileName := GikoSys.GetConfigDir + ROUND_ITEM_FILENAME;
274     if FileExists(FileName) then begin
275     sl.LoadFromFile(FileName);
276     //鐃?鐃?鐃緒申鐃緒申鐃?鐃?鐃?鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申
277     for i := 1 to sl.Count - 1 do begin
278     Item := ParseRoundLine(sl[i], grtItem);
279     FItemList.Add(Item);
280     RoundNameList.Add(Item.RoundName);
281     end;
282     end;
283     finally
284     sl.Free;
285     end;
286     end;
287    
288     procedure TRoundList.SaveRoundFile;
289     var
290     i: integer;
291     FileName: string;
292     sl: TStringList;
293     s: string;
294     Item: TRoundItem;
295     begin
296     GikoSys.ForceDirectoriesEx(GikoSys.GetConfigDir);
297    
298     sl := TStringList.Create;
299     try
300     FileName := GikoSys.GetConfigDir + ROUND_BOARD_FILENAME;
301     sl.Add(ROUND_INDEX_VERSION);
302     for i := 0 to FBoardList.Count - 1 do begin
303     Item := TRoundItem(FBoardList[i]);
304 yoffy 1.3 s := Item.URL + #1
305 hi_ 1.1 + Item.BoardTitle + #1
306     + Item.RoundName;
307     sl.Add(s);
308     end;
309     sl.SaveToFile(FileName);
310     sl.Clear;
311     FileName := GikoSys.GetConfigDir + ROUND_ITEM_FILENAME;
312     sl.Add(ROUND_INDEX_VERSION);
313     for i := 0 to FItemList.Count - 1 do begin
314     Item := TRoundItem(FItemList[i]);
315 yoffy 1.3 s := Item.URL + #1
316 hi_ 1.1 + Item.BoardTitle + #1
317     + Item.FileName + #1
318     + Item.ThreadTitle + #1
319     + Item.RoundName;
320     sl.Add(s);
321     end;
322     sl.SaveToFile(FileName);
323     finally
324     sl.Free;
325     end;
326     end;
327    
328     function TRoundList.ParseRoundLine(Line: string; RoundType: TGikoRoundType): TRoundItem;
329     var
330     s: string;
331     i: Integer;
332     begin
333     Result := TRoundItem.Create;
334     if RoundType = grtBoard then begin
335     Result.ThreadTitle := '';
336     Result.FileName := '';
337     Result.RoundType := grtBoard;
338     for i := 0 to 2 do begin
339     s := GikoSys.GetTokenIndex(Line, #1, i);
340     case i of
341 yoffy 1.3 0:
342     begin
343     Result.URL := s;
344     Result.Item := BBSsFindBoardFromURL( s );
345     end;
346 hi_ 1.1 1: Result.BoardTitle := s;
347     2: Result.RoundName := s;
348     end;
349     end;
350     end else if RoundType = grtItem then begin
351     Result.RoundType := grtItem;
352     for i := 0 to 4 do begin
353     s := GikoSys.GetTokenIndex(Line, #1, i);
354     case i of
355 yoffy 1.3 0:
356     begin
357     Result.URL := s;
358     Result.Item := BBSsFindThreadFromURL( s );
359     end;
360 hi_ 1.1 1: Result.BoardTitle := s;
361     2: Result.FileName := s;
362     3: Result.ThreadTitle := s;
363     4: Result.RoundName := s;
364     end;
365     end;
366     end;
367     end;
368 h677 1.4 procedure TRoundList.ConvertRoundFile;
369     var
370     i: Integer;
371     sl: TStringList;
372     FileName: string;
373     Item: TRoundItem;
374     begin
375     FBoardList.Clear;
376     FItemList.Clear;
377    
378     sl := TStringList.Create;
379     try
380     //鐃?鐃?鐃?鐃緒申鐃緒申鐃?鐃?鐃?鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申
381     FileName := GikoSys.GetConfigDir + ROUND_BOARD_FILENAME;
382     if FileExists(FileName) then begin
383     sl.LoadFromFile(FileName);
384     //鐃?鐃?鐃緒申鐃緒申鐃?鐃?鐃?鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申
385     for i := 1 to sl.Count - 1 do begin
386     Item := ParseOldRoundLine(sl[i], grtBoard);
387     FBoardList.Add(Item);
388     RoundNameList.Add(Item.RoundName);
389     end;
390     end;
391     //鐃?鐃緒申鐃緒申鐃緒申鐃?鐃?鐃?鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申
392     FileName := GikoSys.GetConfigDir + ROUND_ITEM_FILENAME;
393     if FileExists(FileName) then begin
394     sl.LoadFromFile(FileName);
395     //鐃?鐃?鐃緒申鐃緒申鐃?鐃?鐃?鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申
396     for i := 1 to sl.Count - 1 do begin
397     Item := ParseOldRoundLine(sl[i], grtItem);
398     FItemList.Add(Item);
399     RoundNameList.Add(Item.RoundName);
400     end;
401     end;
402     finally
403     sl.Free;
404     end;
405     end;
406     {
407     var
408     i: integer;
409     FileName: string;
410     sl: TStringList;
411     s: string;
412     Item: TRoundItem;
413     begin
414     GikoSys.ForceDirectoriesEx(GikoSys.GetConfigDir);
415    
416     sl := TStringList.Create;
417     try
418     FileName := GikoSys.GetConfigDir + ROUND_BOARD_FILENAME;
419     sl.Add(ROUND_INDEX_VERSION);
420     for i := 0 to FBoardList.Count - 1 do begin
421     Item := TRoundItem(FBoardList[i]);
422     s := Item.URL + #1
423     + Item.BoardTitle + #1
424     + Item.RoundName;
425     sl.Add(s);
426     end;
427     sl.SaveToFile(FileName);
428     sl.Clear;
429     FileName := GikoSys.GetConfigDir + ROUND_ITEM_FILENAME;
430     sl.Add(ROUND_INDEX_VERSION);
431     for i := 0 to FItemList.Count - 1 do begin
432     Item := TRoundItem(FItemList[i]);
433     s := Item.URL + #1
434     + Item.BoardTitle + #1
435     + Item.FileName + #1
436     + Item.ThreadTitle + #1
437     + Item.RoundName;
438     sl.Add(s);
439     end;
440     sl.SaveToFile(FileName);
441     finally
442     sl.Free;
443     end;
444     }
445     function TRoundList.ParseOldRoundLine(Line: string; RoundType: TGikoRoundType): TRoundItem;
446     var
447     i: Integer;
448     s: string;
449     buf: string;
450     board: TBoard;
451     threadItem: TThreadItem;
452     begin
453     Result := TRoundItem.Create;
454     if RoundType = grtBoard then begin
455     Result.ThreadTitle := '';
456     Result.FileName := '';
457     Result.RoundType := grtBoard;
458     for i := 0 to 1 do begin
459     s := GikoSys.GetTokenIndex(Line, #1, i);
460     case i of
461     0:
462     begin
463     Result.BoardTitle := s;
464     board := BBSs[ 0 ].FindBBSID( s );
465     Result.URL := board.URL;
466     Result.Item := BBSsFindBoardFromURL( Result.URL );
467     end;
468     1: Result.RoundName := s;
469     end;
470     end;
471     end else if RoundType = grtItem then begin
472     Result.RoundType := grtItem;
473     for i := 0 to 3 do begin
474     s := GikoSys.GetTokenIndex(Line, #1, i);
475     case i of
476     0: Result.BoardTitle := s;
477     1:
478     begin
479     Result.FileName := s;
480     board := BBSs[ 0 ].FindBoardFromTitle(Result.BoardTitle);
481     if board <> nil then begin
482     buf := Copy(board.GetSendURL,1,LastDelimiter('/', board.GetSendURL)-1);
483     Result.URL := buf + '/read.cgi/'+ board.BBSID+ '/' +ChangeFileExt(s,'') + '/l50';
484     threadItem := BBSsFindThreadFromURL(Result.URL);
485     if threadItem <> nil then begin
486     Result.Item := threadItem;
487     end;
488     end;
489     end;
490     2: Result.ThreadTitle := s;
491     3: Result.RoundName := s;
492     end;
493     end;
494     end;
495     end;
496    
497    
498 hi_ 1.1
499     end.

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