Develop and Download Open Source Software

Browse CVS Repository

Contents of /gikonavigoeson/gikonavi/RoundData.pas

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


Revision 1.6 - (show 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 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 FOldFileRead: Boolean;
16 FBoardList: TList;
17 FItemList: TList;
18 function GetCount(RoundType: TGikoRoundType): Integer;
19 function GetRoundItem(Index: Integer; RoundType: TGikoRoundType): TRoundItem;
20 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 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 procedure Delete(URL: string; RoundType: TGikoRoundType); overload;
34 procedure Clear;
35 function Find(Board: TBoard): Integer; overload;
36 function Find(ThreadItem: TThreadItem): Integer; overload;
37 function Find(URL: string; RoundType: TGikoRoundType): Integer; overload;
38 property Count[RoundType: TGikoRoundType]: Integer read GetCount;
39 property OldFileRead: Boolean read FOldFileRead;
40 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 procedure LoadRoundBoardFile;
45 procedure LoadRoundThreadFile;
46 procedure SaveRoundFile;
47 end;
48
49 TRoundItem = class(TObject)
50 private
51 // FBBSType: TGikoBBSType;
52 FRoundName: string;
53 FRoundType: TGikoRoundType;
54 //Item : TObject;
55 FURL : string;
56 FBoardTitle: string;
57 FThreadTitle: string;
58 FFileName: string;
59 FBoolData: Boolean; //鐃緒申鐃緒申鐃緒申鐃緒申鐃?鐃緒申鐃緒申鐃緒申
60 public
61
62 constructor Create;
63 //property BBSType: TGikoBBSType read FBBSType write FBBSType;
64 property RoundName: string read FRoundName write FRoundName;
65 property RoundType: TGikoRoundType read FRoundType write FRoundType;
66 //property Item : TObject read FItem write FItem;
67 property URL : string read FURL write FURL;
68 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 ROUND_INDEX_VERSION: string = '2.00';
82
83 constructor TRoundItem.Create;
84 begin
85 inherited Create;
86 end;
87 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 FOldFileRead := false;
96 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 Result := -1;
113 idx := Find(Board);
114 if idx = -1 then begin
115 Item := TRoundItem.Create;
116 // Item.BBSType := gbt2ch; //鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申
117 Item.RoundType := grtBoard;
118 // Item.Item := Board;
119 Item.URL := Board.URL;
120 Item.BoardTitle := Board.Title;
121 Item.ThreadTitle := '';
122 Item.FileName := '';
123 Item.RoundName := Board.RoundName;
124 Result := FBoardList.Add(Item);
125 end;
126 end;
127
128 function TRoundList.Add(ThreadItem: TThreadItem): Integer;
129 var
130 idx: Integer;
131 Item: TRoundItem;
132 begin
133 Result := -1;
134 idx := Find(ThreadItem);
135 if idx = -1 then begin
136 Item := TRoundItem.Create;
137 // Item.BBSType := gbt2ch; //鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申
138 Item.RoundType := grtItem;
139 // Item.Item := ThreadItem;
140 Item.URL := Threaditem.URL;
141 Item.BoardTitle := ThreadItem.ParentBoard.Title;
142 Item.ThreadTitle := ThreadItem.Title;
143 Item.FileName := ThreadItem.FileName;
144 Item.RoundName := ThreadItem.RoundName;
145 Result := FItemList.Add(Item);
146 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 if Item.FURL = Board.URL then begin
199 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 if Item.FURL = ThreadItem.URL then begin
215 Result := i;
216 Exit;
217 end;
218 end;
219 end;
220 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
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 procedure TRoundList.LoadRoundBoardFile;
304 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 Item := TRoundItem.Create;
317 //鐃?鐃?鐃緒申鐃緒申鐃?鐃?鐃?鐃緒申鐃緒申
318 if sl[0] = ROUND_INDEX_VERSION then begin
319 for i := 1 to sl.Count - 1 do begin
320
321 Item := ParseRoundBoardLine(sl[i]);
322 FBoardList.Add(Item);
323 RoundNameList.Add(Item.RoundName);
324 end;
325 end else begin
326 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 end;
335 end;
336 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 //鐃?鐃緒申鐃緒申鐃緒申鐃?鐃?鐃?鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申
354 FileName := GikoSys.GetConfigDir + ROUND_ITEM_FILENAME;
355 if FileExists(FileName) then begin
356 sl.LoadFromFile(FileName);
357 Item := TRoundItem.Create;
358 //鐃?鐃?鐃緒申鐃緒申鐃?鐃?鐃?鐃緒申鐃緒申
359 if sl[0] = ROUND_INDEX_VERSION then begin
360 for i := 1 to sl.Count - 1 do begin
361
362 Item := ParseRoundThreadLine(sl[i], boardList);
363 FItemList.Add(Item);
364 RoundNameList.Add(Item.RoundName);
365 end;
366 end else begin
367 LoadRoundBoardFile;
368 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 end;
375 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 finally
382 sl.Free;
383 boardList.Free;
384 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 s := Item.URL + #1
403 + 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 s := Item.URL + #1
414 + 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 function TRoundList.ParseRoundBoardLine(Line: string): TRoundItem;
426 var
427 s: string;
428 i: Integer;
429 begin
430 Result := TRoundItem.Create;
431 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 begin
439 Result.URL := s;
440 end;
441 1: Result.BoardTitle := s;
442 2: Result.RoundName := s;
443 end;
444 end;
445 end;
446
447 function TRoundList.ParseRoundThreadLine(Line: string; var BoardList : TStringList): TRoundItem;
448 var
449 s: string;
450 i: Integer;
451 threadItem: TThreadItem;
452 begin
453 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
474 function TRoundList.ParseOldRoundBoardLine(Line: string): TRoundItem;
475 var
476 i: Integer;
477 s: string;
478 board: TBoard;
479 begin
480 Result := TRoundItem.Create;
481 Result.ThreadTitle := '';
482 Result.FileName := '';
483 Result.RoundType := grtBoard;
484 for i := 0 to 2 do begin
485 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 1: Result.FBoardTitle := s;
493 2: Result.RoundName := s;
494 end;
495 end;
496 end;
497
498 function TRoundList.ParseOldRoundThreadLine(Line: string; var BoardList : TStringList): TRoundItem;
499 var
500 i: Integer;
501 s: string;
502 buf: string;
503 board: TBoard;
504 threadItem: TThreadItem;
505 bbsID: string;
506 begin
507 Result := TRoundItem.Create;
508 Result.RoundType := grtItem;
509 for i := 0 to 4 do begin
510 s := GikoSys.GetTokenIndex(Line, #1, i);
511 case i of
512 0: bbsID := s;
513 1: Result.BoardTitle := s;
514 2:
515 begin
516 Result.FileName := s;
517 board := BBSs[ 0 ].FindBoardFromTitle(Result.BoardTitle);
518 if board <> nil then begin
519 BoardList.Add(board.URL);
520 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 3: Result.ThreadTitle := s;
525 4: Result.RoundName := s;
526 end;
527 end;
528 end;
529
530 end.

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