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.6 - (hide annotations) (download) (as text)
Wed Dec 10 13:52:57 2003 UTC (20 years, 4 months ago) by h677
Branch: MAIN
Changes since 1.5: +77 -28 lines
File MIME type: text/x-pascal
旧巡回ファイルフォーマットの読み込み処理&新ファイルフォーマット読み込み不良対策

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

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