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

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