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.13 - (show annotations) (download) (as text)
Wed Dec 24 08:18:31 2003 UTC (20 years, 3 months ago) by deux
Branch: MAIN
Changes since 1.12: +8 -8 lines
File MIME type: text/x-pascal
・巡回の順序が逆(新しい順)だったのを、ハ゛タ43と同じように登録した順に戻した
・新しく登録した巡回アイテムが先頭に追加されたのを、ハ゛タ43と同じように末尾に追加するように戻した。

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): TRoundItem;
22 function ParseOldRoundBoardLine(Line: string): TRoundItem;
23 function ParseOldRoundThreadLine(Line: string): 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 ERROR_BOARD_FILENAME: string = 'ErrorBoard.2ch'; //Error鐃?鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申
83 ERROR_ITEM_FILENAME: string = 'ErrorItem.2ch'; //Error鐃?鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申
84 constructor TRoundItem.Create;
85 begin
86 inherited Create;
87 end;
88 constructor TRoundList.Create;
89 begin
90 inherited;
91 FBoardList := TList.Create;
92 FItemList := TList.Create;
93 RoundNameList := TStringList.Create;
94 RoundNameList.Sorted := True;
95 RoundNameList.Duplicates := dupIgnore;
96 FOldFileRead := false;
97 end;
98
99 destructor TRoundList.Destroy;
100 begin
101 RoundNameList.Free;
102 Clear;
103 FBoardList.Free;
104 FItemList.Free;
105 //inherited;
106 end;
107
108 function TRoundList.Add(Board: TBoard): Integer;
109 var
110 idx: Integer;
111 Item: TRoundItem;
112 begin
113 Result := -1;
114 idx := Find(Board);
115 if idx = -1 then begin
116 Item := TRoundItem.Create;
117 // Item.BBSType := gbt2ch; //鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申
118 Item.RoundType := grtBoard;
119 // Item.Item := Board;
120 Item.URL := Board.URL;
121 Item.BoardTitle := Board.Title;
122 Item.ThreadTitle := '';
123 Item.FileName := '';
124 Item.RoundName := Board.RoundName;
125 Result := FBoardList.Add(Item);
126 end;
127 end;
128
129 function TRoundList.Add(ThreadItem: TThreadItem): Integer;
130 var
131 idx: Integer;
132 Item: TRoundItem;
133 begin
134 Result := -1;
135 idx := Find(ThreadItem);
136 if idx = -1 then begin
137 Item := TRoundItem.Create;
138 // Item.BBSType := gbt2ch; //鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申
139 Item.RoundType := grtItem;
140 // Item.Item := ThreadItem;
141 Item.URL := Threaditem.URL;
142 Item.BoardTitle := ThreadItem.ParentBoard.Title;
143 Item.ThreadTitle := ThreadItem.Title;
144 Item.FileName := ThreadItem.FileName;
145 Item.RoundName := ThreadItem.RoundName;
146 Result := FItemList.Add(Item);
147 end;
148 end;
149
150 procedure TRoundList.Delete(Board: TBoard);
151 var
152 idx: Integer;
153 // Item: TRoundItem;
154 begin
155 idx := Find(Board);
156 if idx <> -1 then begin
157 TRoundItem(FBoardList[idx]).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 TRoundItem(FItemList[idx]).Free;
170 FItemList.Delete(idx);
171 end;
172 end;
173
174 procedure TRoundList.Clear;
175 var
176 i: Integer;
177 begin
178 for i := 0 to FBoardList.Count - 1 do begin
179 if FBoardList[i] <> nil then
180 TRoundItem(FBoardList[i]).Free;
181 FBoardList.Delete(i);
182 end;
183 for i := 0 to FItemList.Count - 1 do begin
184 if FItemList[i] <> nil then
185 TRoundItem(FItemList[i]).Free;
186 FItemList.Delete(i);
187 end;
188 end;
189
190 function TRoundList.Find(Board: TBoard): Integer;
191 var
192 i: Integer;
193 Item: TRoundItem;
194 begin
195 Result := -1;
196 for i := 0 to FBoardList.Count - 1 do begin
197 Item := TRoundItem(FBoardList[i]);
198 if Item.FRoundType <> grtBoard then Continue;
199 if Item.FURL = Board.URL then begin
200 Result := i;
201 Exit;
202 end;
203 end;
204 end;
205
206 function TRoundList.Find(ThreadItem: TThreadItem): Integer;
207 var
208 i: Integer;
209 Item: TRoundItem;
210 begin
211 Result := -1;
212 for i := 0 to FItemList.Count - 1 do begin
213 Item := TRoundItem(FItemList[i]);
214 if Item.FRoundType <> grtItem then Continue;
215 if Item.FURL = ThreadItem.URL then begin
216 Result := i;
217 Exit;
218 end;
219 end;
220 end;
221 function TRoundList.Find(URL: string; RoundType: TGikoRoundType): Integer;
222 var
223 i: Integer;
224 Item: TRoundItem;
225 begin
226 Result := -1;
227 for i := 0 to FItemList.Count - 1 do begin
228 Item := TRoundItem(FItemList[i]);
229 if Item.FRoundType <> RoundType then Continue;
230 if Item.FURL = URL then begin
231 Result := i;
232 Exit;
233 end;
234 end;
235 end;
236 procedure TRoundList.Delete(URL: string; RoundType: TGikoRoundType);
237 var
238 idx: Integer;
239 Item: TRoundItem;
240 board: TBoard;
241 threadItem: TThreadItem;
242 begin
243 idx := Find(URL, RoundType);
244 if idx <> -1 then begin
245 Item := TRoundItem(FItemList[idx]);
246 Item.Free;
247 FItemList.Delete(idx);
248 if RoundType = grtBoard then begin
249 board := BBSsFindBoardFromURL(URL);
250 board.Round := False;
251 board.RoundName := '';
252 end else begin
253 threadItem := BBSsFindThreadFromURL(URL);
254 threadItem.Round := false;
255 threadItem.RoundName := '';
256 end;
257 end;
258 end;
259
260 procedure TRoundList.SetRoundName(Board: TBoard; RoundName: string);
261 var
262 idx: Integer;
263 Item: TRoundItem;
264 begin
265 idx := Find(Board);
266 if idx <> -1 then begin
267 Item := TRoundItem(FBoardList[idx]);
268 Item.RoundName := RoundName;
269 end;
270 end;
271
272 procedure TRoundList.SetRoundName(ThreadItem: TThreadItem; RoundName: string);
273 var
274 idx: Integer;
275 Item: TRoundItem;
276 begin
277 idx := Find(ThreadItem);
278 if idx <> -1 then begin
279 Item := TRoundItem(FItemList[idx]);
280 Item.RoundName := RoundName;
281 end;
282 end;
283
284 function TRoundList.GetCount(RoundType: TGikoRoundType): Integer;
285 begin
286 Result := 0;
287 if RoundType = grtBoard then
288 Result := FBoardList.Count
289 else if RoundType = grtItem then
290 Result := FItemList.Count;
291 end;
292
293 function TRoundList.GetRoundItem(Index: Integer; RoundType: TGikoRoundType): TRoundItem;
294 begin
295 Result := nil;
296 if RoundType = grtBoard then begin
297 if (Index >= 0) and (Index < FBoardList.Count) then
298 Result := TRoundItem(FBoardList[Index]);
299 end else if RoundType = grtItem then begin
300 if (Index >= 0) and (Index < FItemList.Count) then
301 Result := TRoundItem(FItemList[Index]);
302 end;
303 end;
304 procedure TRoundList.LoadRoundBoardFile;
305 var
306 i: Integer;
307 sl: TStringList;
308 FileName: string;
309 errorSl: TStringList;
310 errorFileName: string;
311 Item: TRoundItem;
312 begin
313 sl := TStringList.Create;
314 errorSl := TStringList.Create;
315 errorSl.Duplicates := dupIgnore;
316 try
317 //鐃?鐃?鐃?鐃緒申鐃緒申鐃?鐃?鐃?鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申
318 FileName := GikoSys.GetConfigDir + ROUND_BOARD_FILENAME;
319 //鐃?鐃緒申鐃?鐃?鐃緒申鐃緒申鐃?鐃?鐃?鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申
320 errorFileName := GikoSys.GetConfigDir + ERROR_BOARD_FILENAME;
321 if FileExists(FileName) then begin
322 sl.LoadFromFile(FileName);
323 if FileExists(errorFileName) then begin
324 try
325 errorSl.LoadFromFile(errorFileName);
326 except
327 end;
328 end;
329 //Item := TRoundItem.Create;
330 //鐃?鐃?鐃緒申鐃緒申鐃?鐃?鐃?鐃緒申鐃緒申
331 if sl[0] = ROUND_INDEX_VERSION then begin
332 for i := 1 to sl.Count - 1 do begin
333 Item := ParseRoundBoardLine(sl[i]);
334 if Item <> nil then begin
335 FBoardList.Add(Item);
336 RoundNameList.Add(Item.RoundName);
337 end else begin
338 errorSl.Add( sl[i] );
339 sl.Delete(i);
340 end;
341 end;
342 end else begin
343 if FOldFileRead then begin //鐃?鐃?鐃?鐃?鐃?鐃緒申鐃緒申鐃?鐃?鐃?鐃?鐃?鐃?鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃?鐃緒申鐃?鐃?鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申
344 for i := 1 to sl.Count - 1 do begin
345 Item := ParseOldRoundBoardLine(sl[i]);
346 if Item <> nil then begin
347 FBoardList.Add(Item);
348 RoundNameList.Add(Item.RoundName);
349 end else begin
350 errorSl.Add( sl[i] );
351 sl.Delete(i);
352 end;
353 end;
354 end else
355 FOldFileRead := true;
356 end;
357 end;
358 if errorSl.Count > 0 then
359 errorSl.SaveToFile(errorFileName);
360 finally
361 errorSl.Free;
362 sl.Free;
363 end;
364 end;
365 procedure TRoundList.LoadRoundThreadFile;
366 var
367 i: Integer;
368 // j: Integer;
369 sl: TStringList;
370 FileName: string;
371 errorSl: TStringList;
372 errorFileName: string;
373 Item: TRoundItem;
374 // boardList : TStringList;
375 begin
376 // boardList := TStringList.Create;
377 // boardList.Duplicates := dupIgnore;
378 errorSl := TStringList.Create;
379 errorSl.Duplicates := dupIgnore;
380 sl := TStringList.Create;
381 try
382 //鐃?鐃緒申鐃緒申鐃緒申鐃?鐃?鐃?鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申
383 FileName := GikoSys.GetConfigDir + ROUND_ITEM_FILENAME;
384 //鐃?鐃緒申鐃?鐃?鐃緒申鐃緒申鐃?鐃?鐃?鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申
385 errorFileName := GikoSys.GetConfigDir + ERROR_ITEM_FILENAME;
386 if FileExists(FileName) then begin
387 sl.LoadFromFile(FileName);
388 if FileExists(errorFileName) then begin
389 try
390 errorSl.LoadFromFile(errorFileName);
391 except
392 end;
393 end;
394 //Item := TRoundItem.Create;
395 //鐃?鐃?鐃緒申鐃緒申鐃?鐃?鐃?鐃緒申鐃緒申
396 if sl[0] = ROUND_INDEX_VERSION then begin
397 for i := 1 to sl.Count - 1 do begin
398 Item := ParseRoundThreadLine(sl[i]);
399 if Item <> nil then begin
400 FItemList.Add(Item);
401 RoundNameList.Add(Item.RoundName);
402 end else begin
403 errorSl.Add(sl[i]);
404 sl.Delete(i);
405 end;
406 end;
407 end else begin
408 LoadRoundBoardFile;
409 for i := 1 to sl.Count - 1 do begin
410 Item := ParseOldRoundThreadLine(sl[i]);
411 if Item <> nil then begin
412 FItemList.Add(Item);
413 RoundNameList.Add(Item.RoundName);
414 end else begin
415 errorSl.Add(sl[i]);
416 sl.Delete(i);
417 end;
418 end;
419 end;
420 // j := boardList.Count - 1;
421 // while j >= 0 do begin
422 // GikoSys.ReadSubjectFile( BBSsFindBoardFromURL( boardList[j] ) );
423 // boardList.Delete(j);
424 // Dec(j);
425 // end;
426 if errorSl.Count > 0 then
427 errorSl.SaveToFile(errorFileName);
428 end;
429 finally
430 sl.Free;
431 // boardList.Free;
432 end;
433 end;
434 procedure TRoundList.SaveRoundFile;
435 var
436 i: integer;
437 FileName: string;
438 sl: TStringList;
439 s: string;
440 Item: TRoundItem;
441 begin
442 GikoSys.ForceDirectoriesEx(GikoSys.GetConfigDir);
443
444 sl := TStringList.Create;
445 try
446 FileName := GikoSys.GetConfigDir + ROUND_BOARD_FILENAME;
447 sl.Add(ROUND_INDEX_VERSION);
448 for i := 0 to FBoardList.Count - 1 do begin
449 Item := TRoundItem(FBoardList[i]);
450 s := Item.URL + #1
451 + Item.BoardTitle + #1
452 + Item.RoundName;
453 sl.Add(s);
454 end;
455 sl.SaveToFile(FileName);
456 sl.Clear;
457 FileName := GikoSys.GetConfigDir + ROUND_ITEM_FILENAME;
458 sl.Add(ROUND_INDEX_VERSION);
459 for i := 0 to FItemList.Count - 1 do begin
460 Item := TRoundItem(FItemList[i]);
461 s := Item.URL + #1
462 + Item.BoardTitle + #1
463 + Item.FileName + #1
464 + Item.ThreadTitle + #1
465 + Item.RoundName;
466 sl.Add(s);
467 end;
468 sl.SaveToFile(FileName);
469 finally
470 sl.Free;
471 end;
472 end;
473 function TRoundList.ParseRoundBoardLine(Line: string): TRoundItem;
474 var
475 s: string;
476 i: Integer;
477 begin
478 Result := TRoundItem.Create;
479 Result.ThreadTitle := '';
480 Result.FileName := '';
481 Result.RoundType := grtBoard;
482 for i := 0 to 2 do begin
483 s := GikoSys.GetTokenIndex(Line, #1, i);
484 try
485 case i of
486 0:
487 begin
488 Result.URL := s;
489 end;
490 1: Result.BoardTitle := s;
491 2: Result.RoundName := s;
492 end;
493 except
494 Result := nil;
495 Exit;
496 end;
497 end;
498 end;
499
500 function TRoundList.ParseRoundThreadLine(Line: string): TRoundItem;
501 var
502 s: string;
503 i: Integer;
504 // threadItem: TThreadItem;
505 begin
506 Result := TRoundItem.Create;
507 Result.RoundType := grtItem;
508 for i := 0 to 4 do begin
509 s := GikoSys.GetTokenIndex(Line, #1, i);
510 try
511 case i of
512 0:
513 begin
514 Result.URL := s;
515 //threadItem := BBSsFindThreadFromURL( s );
516 //if threadItem <> nil then begin
517 // BoardList.Add( threadItem.ParentBoard.URL );
518 //end;
519 end;
520 1: Result.BoardTitle := s;
521 2: Result.FileName := s;
522 3: Result.ThreadTitle := s;
523 4: Result.RoundName := s;
524 end;
525 except
526 Result := nil;
527 Exit;
528 end;
529 end;
530 end;
531
532 function TRoundList.ParseOldRoundBoardLine(Line: string): TRoundItem;
533 var
534 i: Integer;
535 s: string;
536 board: TBoard;
537 begin
538 Result := TRoundItem.Create;
539 Result.ThreadTitle := '';
540 Result.FileName := '';
541 Result.RoundType := grtBoard;
542 for i := 0 to 2 do begin
543 s := GikoSys.GetTokenIndex(Line, #1, i);
544 try
545 case i of
546 0:
547 begin
548 board := BBSs[ 0 ].FindBBSID( s );
549 if board <> nil then begin
550 Result.URL := board.URL;
551 end else begin
552 raise Exception.Create('鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃?鐃緒申鐃緒申鐃?鐃緒申鐃緒申鐃?');
553 end;
554 end;
555 1: Result.FBoardTitle := s;
556 2: Result.RoundName := s;
557 end;
558 except
559 Result := nil;
560 Exit;
561 end;
562 end;
563 end;
564
565 function TRoundList.ParseOldRoundThreadLine(Line: string): TRoundItem;
566 var
567 i: Integer;
568 s: string;
569 buf: string;
570 board: TBoard;
571 // threadItem: TThreadItem;
572 bbsID: string;
573 begin
574 Result := TRoundItem.Create;
575 Result.RoundType := grtItem;
576 for i := 0 to 4 do begin
577 s := GikoSys.GetTokenIndex(Line, #1, i);
578 try
579 case i of
580 0: bbsID := s;
581 1: Result.BoardTitle := s;
582 2:
583 begin
584 Result.FileName := s;
585 board := BBSs[ 0 ].FindBBSID(bbsID);
586 if board <> nil then begin
587 buf := Copy(board.GetSendURL,1,LastDelimiter('/', board.GetSendURL)-1);
588 Result.URL := buf + '/read.cgi/'+ board.BBSID+ '/' +ChangeFileExt(s,'') + '/l50';
589 end else begin
590 raise Exception.Create('鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申');
591 end;
592 end;
593 3: Result.ThreadTitle := s;
594 4: Result.RoundName := s;
595 end;
596 except
597 Result := nil;
598 Exit;
599 end;
600 end;
601 end;
602
603 end.

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