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.14 - (show annotations) (download) (as text)
Tue Jan 6 13:49:18 2004 UTC (20 years, 3 months ago) by h677
Branch: MAIN
Changes since 1.13: +36 -16 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): 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 := FBoardList.Count - 1 downto 0 do begin
179 if FBoardList[i] <> nil then
180 TRoundItem(FBoardList[i]).Free;
181 FBoardList.Delete(i);
182 end;
183 for i := FItemList.Count - 1 downto 0 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 if RoundType = grtItem then begin
228 for i := 0 to FItemList.Count - 1 do begin
229 Item := TRoundItem(FItemList[i]);
230 if Item.FRoundType <> RoundType then Continue;
231 if Item.FURL = URL then begin
232 Result := i;
233 Exit;
234 end;
235 end;
236 end else begin
237 for i := 0 to FBoardList.Count - 1 do begin
238 Item := TRoundItem(FBoardList[i]);
239 if Item.FRoundType <> RoundType then Continue;
240 if Item.FURL = URL then begin
241 Result := i;
242 Exit;
243 end;
244 end;
245 end;
246 end;
247 procedure TRoundList.Delete(URL: string; RoundType: TGikoRoundType);
248 var
249 idx: Integer;
250 Item: TRoundItem;
251 board: TBoard;
252 threadItem: TThreadItem;
253 begin
254 idx := Find(URL, RoundType);
255 if idx <> -1 then begin
256
257 if RoundType = grtBoard then begin
258 Item := TRoundItem(FBoardList[idx]);
259 Item.Free;
260 FBoardList.Delete(idx);
261 board := BBSsFindBoardFromURL(URL);
262 if board <> nil then begin
263 board.Round := False;
264 board.RoundName := '';
265 end;
266 end else begin
267 Item := TRoundItem(FItemList[idx]);
268 Item.Free;
269 FItemList.Delete(idx);
270
271 threadItem := BBSsFindThreadFromURL(URL);
272 if threadItem <> nil then begin
273 threadItem.Round := false;
274 threadItem.RoundName := '';
275 end;
276 end;
277 end;
278 end;
279
280 procedure TRoundList.SetRoundName(Board: TBoard; RoundName: string);
281 var
282 idx: Integer;
283 Item: TRoundItem;
284 begin
285 idx := Find(Board);
286 if idx <> -1 then begin
287 Item := TRoundItem(FBoardList[idx]);
288 Item.RoundName := RoundName;
289 end;
290 end;
291
292 procedure TRoundList.SetRoundName(ThreadItem: TThreadItem; RoundName: string);
293 var
294 idx: Integer;
295 Item: TRoundItem;
296 begin
297 idx := Find(ThreadItem);
298 if idx <> -1 then begin
299 Item := TRoundItem(FItemList[idx]);
300 Item.RoundName := RoundName;
301 end;
302 end;
303
304 function TRoundList.GetCount(RoundType: TGikoRoundType): Integer;
305 begin
306 Result := 0;
307 if RoundType = grtBoard then
308 Result := FBoardList.Count
309 else if RoundType = grtItem then
310 Result := FItemList.Count;
311 end;
312
313 function TRoundList.GetRoundItem(Index: Integer; RoundType: TGikoRoundType): TRoundItem;
314 begin
315 Result := nil;
316 if RoundType = grtBoard then begin
317 if (Index >= 0) and (Index < FBoardList.Count) then
318 Result := TRoundItem(FBoardList[Index]);
319 end else if RoundType = grtItem then begin
320 if (Index >= 0) and (Index < FItemList.Count) then
321 Result := TRoundItem(FItemList[Index]);
322 end;
323 end;
324 procedure TRoundList.LoadRoundBoardFile;
325 var
326 i: Integer;
327 sl: TStringList;
328 FileName: string;
329 errorSl: TStringList;
330 errorFileName: string;
331 Item: TRoundItem;
332 begin
333 sl := TStringList.Create;
334 errorSl := TStringList.Create;
335 errorSl.Duplicates := dupIgnore;
336 try
337 //鐃?鐃?鐃?鐃緒申鐃緒申鐃?鐃?鐃?鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申
338 FileName := GikoSys.GetConfigDir + ROUND_BOARD_FILENAME;
339 //鐃?鐃緒申鐃?鐃?鐃緒申鐃緒申鐃?鐃?鐃?鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申
340 errorFileName := GikoSys.GetConfigDir + ERROR_BOARD_FILENAME;
341 if FileExists(FileName) then begin
342 sl.LoadFromFile(FileName);
343 if FileExists(errorFileName) then begin
344 try
345 errorSl.LoadFromFile(errorFileName);
346 except
347 end;
348 end;
349 //Item := TRoundItem.Create;
350 //鐃?鐃?鐃緒申鐃緒申鐃?鐃?鐃?鐃緒申鐃緒申
351 if sl[0] = ROUND_INDEX_VERSION then begin
352 for i := 1 to sl.Count - 1 do begin
353 Item := ParseRoundBoardLine(sl[i]);
354 if Item <> nil then begin
355 FBoardList.Add(Item);
356 RoundNameList.Add(Item.RoundName);
357 end else begin
358 errorSl.Add( sl[i] );
359 sl.Delete(i);
360 end;
361 end;
362 end else begin
363 if FOldFileRead then begin //鐃?鐃?鐃?鐃?鐃?鐃緒申鐃緒申鐃?鐃?鐃?鐃?鐃?鐃?鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃?鐃緒申鐃?鐃?鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申
364 for i := 1 to sl.Count - 1 do begin
365 Item := ParseOldRoundBoardLine(sl[i]);
366 if Item <> nil then begin
367 FBoardList.Add(Item);
368 RoundNameList.Add(Item.RoundName);
369 end else begin
370 errorSl.Add( sl[i] );
371 sl.Delete(i);
372 end;
373 end;
374 end else
375 FOldFileRead := true;
376 end;
377 end;
378 if errorSl.Count > 0 then
379 errorSl.SaveToFile(errorFileName);
380 finally
381 errorSl.Free;
382 sl.Free;
383 end;
384 end;
385 procedure TRoundList.LoadRoundThreadFile;
386 var
387 i: Integer;
388 // j: Integer;
389 sl: TStringList;
390 FileName: string;
391 errorSl: TStringList;
392 errorFileName: string;
393 Item: TRoundItem;
394 // boardList : TStringList;
395 begin
396 // boardList := TStringList.Create;
397 // boardList.Duplicates := dupIgnore;
398 errorSl := TStringList.Create;
399 errorSl.Duplicates := dupIgnore;
400 sl := TStringList.Create;
401 try
402 //鐃?鐃緒申鐃緒申鐃緒申鐃?鐃?鐃?鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申
403 FileName := GikoSys.GetConfigDir + ROUND_ITEM_FILENAME;
404 //鐃?鐃緒申鐃?鐃?鐃緒申鐃緒申鐃?鐃?鐃?鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申
405 errorFileName := GikoSys.GetConfigDir + ERROR_ITEM_FILENAME;
406 if FileExists(FileName) then begin
407 sl.LoadFromFile(FileName);
408 if FileExists(errorFileName) then begin
409 try
410 errorSl.LoadFromFile(errorFileName);
411 except
412 end;
413 end;
414 //Item := TRoundItem.Create;
415 //鐃?鐃?鐃緒申鐃緒申鐃?鐃?鐃?鐃緒申鐃緒申
416 if sl[0] = ROUND_INDEX_VERSION then begin
417 for i := 1 to sl.Count - 1 do begin
418 Item := ParseRoundThreadLine(sl[i]);
419 if Item <> nil then begin
420 FItemList.Add(Item);
421 RoundNameList.Add(Item.RoundName);
422 end else begin
423 errorSl.Add(sl[i]);
424 sl.Delete(i);
425 end;
426 end;
427 end else begin
428 LoadRoundBoardFile;
429 for i := 1 to sl.Count - 1 do begin
430 Item := ParseOldRoundThreadLine(sl[i]);
431 if Item <> nil then begin
432 FItemList.Add(Item);
433 RoundNameList.Add(Item.RoundName);
434 end else begin
435 errorSl.Add(sl[i]);
436 sl.Delete(i);
437 end;
438 end;
439 end;
440 // j := boardList.Count - 1;
441 // while j >= 0 do begin
442 // GikoSys.ReadSubjectFile( BBSsFindBoardFromURL( boardList[j] ) );
443 // boardList.Delete(j);
444 // Dec(j);
445 // end;
446 if errorSl.Count > 0 then
447 errorSl.SaveToFile(errorFileName);
448 end;
449 finally
450 sl.Free;
451 // boardList.Free;
452 end;
453 end;
454 procedure TRoundList.SaveRoundFile;
455 var
456 i: integer;
457 FileName: string;
458 sl: TStringList;
459 s: string;
460 Item: TRoundItem;
461 begin
462 GikoSys.ForceDirectoriesEx(GikoSys.GetConfigDir);
463
464 sl := TStringList.Create;
465 try
466 FileName := GikoSys.GetConfigDir + ROUND_BOARD_FILENAME;
467 sl.Add(ROUND_INDEX_VERSION);
468 for i := 0 to FBoardList.Count - 1 do begin
469 Item := TRoundItem(FBoardList[i]);
470 s := Item.URL + #1
471 + Item.BoardTitle + #1
472 + Item.RoundName;
473 sl.Add(s);
474 end;
475 sl.SaveToFile(FileName);
476 sl.Clear;
477 FileName := GikoSys.GetConfigDir + ROUND_ITEM_FILENAME;
478 sl.Add(ROUND_INDEX_VERSION);
479 for i := 0 to FItemList.Count - 1 do begin
480 Item := TRoundItem(FItemList[i]);
481 s := Item.URL + #1
482 + Item.BoardTitle + #1
483 + Item.FileName + #1
484 + Item.ThreadTitle + #1
485 + Item.RoundName;
486 sl.Add(s);
487 end;
488 sl.SaveToFile(FileName);
489 finally
490 sl.Free;
491 end;
492 end;
493 function TRoundList.ParseRoundBoardLine(Line: string): TRoundItem;
494 var
495 s: string;
496 i: Integer;
497 begin
498 Result := TRoundItem.Create;
499 Result.ThreadTitle := '';
500 Result.FileName := '';
501 Result.RoundType := grtBoard;
502 for i := 0 to 2 do begin
503 s := GikoSys.GetTokenIndex(Line, #1, i);
504 try
505 case i of
506 0:
507 begin
508 Result.URL := s;
509 end;
510 1: Result.BoardTitle := s;
511 2: Result.RoundName := s;
512 end;
513 except
514 Result := nil;
515 Exit;
516 end;
517 end;
518 end;
519
520 function TRoundList.ParseRoundThreadLine(Line: string): TRoundItem;
521 var
522 s: string;
523 i: Integer;
524 // threadItem: TThreadItem;
525 begin
526 Result := TRoundItem.Create;
527 Result.RoundType := grtItem;
528 for i := 0 to 4 do begin
529 s := GikoSys.GetTokenIndex(Line, #1, i);
530 try
531 case i of
532 0:
533 begin
534 Result.URL := s;
535 //threadItem := BBSsFindThreadFromURL( s );
536 //if threadItem <> nil then begin
537 // BoardList.Add( threadItem.ParentBoard.URL );
538 //end;
539 end;
540 1: Result.BoardTitle := s;
541 2: Result.FileName := s;
542 3: Result.ThreadTitle := s;
543 4: Result.RoundName := s;
544 end;
545 except
546 Result := nil;
547 Exit;
548 end;
549 end;
550 end;
551
552 function TRoundList.ParseOldRoundBoardLine(Line: string): TRoundItem;
553 var
554 i: Integer;
555 s: string;
556 board: TBoard;
557 begin
558 Result := TRoundItem.Create;
559 Result.ThreadTitle := '';
560 Result.FileName := '';
561 Result.RoundType := grtBoard;
562 for i := 0 to 2 do begin
563 s := GikoSys.GetTokenIndex(Line, #1, i);
564 try
565 case i of
566 0:
567 begin
568 board := BBSs[ 0 ].FindBBSID( s );
569 if board <> nil then begin
570 Result.URL := board.URL;
571 end else begin
572 raise Exception.Create('鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃?鐃緒申鐃緒申鐃?鐃緒申鐃緒申鐃?');
573 end;
574 end;
575 1: Result.FBoardTitle := s;
576 2: Result.RoundName := s;
577 end;
578 except
579 Result := nil;
580 Exit;
581 end;
582 end;
583 end;
584
585 function TRoundList.ParseOldRoundThreadLine(Line: string): TRoundItem;
586 var
587 i: Integer;
588 s: string;
589 buf: string;
590 board: TBoard;
591 // threadItem: TThreadItem;
592 bbsID: string;
593 begin
594 Result := TRoundItem.Create;
595 Result.RoundType := grtItem;
596 for i := 0 to 4 do begin
597 s := GikoSys.GetTokenIndex(Line, #1, i);
598 try
599 case i of
600 0: bbsID := s;
601 1: Result.BoardTitle := s;
602 2:
603 begin
604 Result.FileName := s;
605 board := BBSs[ 0 ].FindBBSID(bbsID);
606 if board <> nil then begin
607 buf := Copy(board.GetSendURL,1,LastDelimiter('/', board.GetSendURL)-1);
608 Result.URL := buf + '/read.cgi/'+ board.BBSID+ '/' +ChangeFileExt(s,'') + '/l50';
609 end else begin
610 raise Exception.Create('鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申');
611 end;
612 end;
613 3: Result.ThreadTitle := s;
614 4: Result.RoundName := s;
615 end;
616 except
617 Result := nil;
618 Exit;
619 end;
620 end;
621 end;
622
623 end.

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