Develop and Download Open Source Software

Browse CVS Repository

Contents of /gikonavigoeson/gikonavi/ItemDownload.pas

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


Revision 1.1 - (show annotations) (download) (as text)
Sat Aug 9 13:51:05 2003 UTC (20 years, 8 months ago) by hi_
Branch: MAIN
Branch point for: hi
File MIME type: text/x-pascal
Initial revision

1 unit ItemDownload;
2
3 interface
4
5 uses
6 SysUtils, Classes, ComCtrls, Controls, Forms, IdHTTP,
7 HTTPApp, IdGlobal, IdException, IdComponent, IniFiles, {DateUtils,}
8 GikoSystem, BoardGroup, MonaUtils;
9
10 type
11 TDownloadItem = class;
12 TGikoDownloadType = (gdtBoard, gdtThread);
13 TGikoDownloadState = (gdsWait, gdsWork, gdsComplete, gdsDiffComplete, gdsNotModify, gdsAbort, gdsError);
14 TGikoCgiStatus = (gcsOK, gcsINCR, gcsERR);
15 TGikoDLProgress = (gdpStd, gdpAll, gdpDatOchi, gdpOfflaw);
16
17 TGikoWorkEvent = procedure(Sender: TObject; AWorkMode: TWorkMode; const AWorkCount: Integer; ID: Integer) of object;
18 TGikoWorkBeginEvent = procedure(Sender: TObject; AWorkMode: TWorkMode; const AWorkCountMax: Integer; ID: Integer) of object;
19 TGikoWorkEndEvent = procedure(Sender: TObject; AWorkMode: TWorkMode; ID: Integer) of object;
20 TDownloadEndEvent = procedure(Sender: TObject; Item: TDownloadItem) of object;
21 TDownloadMsgEvent = procedure(Sender: TObject; Item: TDownloadItem; Msg: string; Icon: TGikoMessageIcon) of object;
22
23 TCgiStatus = record
24 FStatus: TGikoCgiStatus;
25 FSize: Integer;
26 FErrText: string;
27 end;
28
29
30 TDownloadThread = class(TThread)
31 private
32 FIndy: TIdHttp;
33 FItem: TDownloadItem;
34 FNumber: Integer;
35 FAbort: Boolean;
36 FMsg: string;
37 FIcon: TGikoMessageIcon;
38 FSessionID: string;
39 FOnWork: TGikoWorkEvent;
40 FOnWorkBegin: TGikoWorkBeginEvent;
41 FOnWorkEnd: TGikoWorkEndEvent;
42 FOnDownloadEnd: TDownloadEndEvent;
43 FOnDownloadMsg: TDownloadMsgEvent;
44
45 procedure FireDownloadEnd;
46 procedure FireDownloadMsg;
47 procedure GetSessionID;
48 procedure WorkBegin(Sender: TObject; AWorkMode: TWorkMode; const AWorkCountMax: Integer);
49 procedure WorkEnd(Sender: TObject; AWorkMode: TWorkMode);
50 procedure Work(Sender: TObject; AWorkMode: TWorkMode; const AWorkCount: Integer);
51 function ParseCgiStatus(Content: string): TCgiStatus;
52 function DatDownload(ItemType: TGikoDownloadType; URL: string; Modified: TDateTime; RangeStart: Integer; AdjustLen: Integer): Boolean;
53 function DeleteStatusLine(Content: string): string;
54 protected
55 procedure Execute; override;
56 public
57 property Item: TDownloadItem read FItem write FItem;
58 property Number: Integer read FNumber write FNumber;
59 constructor Create(CreateSuspended: Boolean);
60 destructor Destroy; override;
61 procedure Abort;
62 property OnWork: TGikoWorkEvent read FOnWork write FOnWork;
63 property OnWorkBegin: TGikoWorkBeginEvent read FOnWorkBegin write FOnWorkBegin;
64 property OnWorkEnd: TGikoWorkEndEvent read FOnWorkEnd write FOnWorkEnd;
65 property OnDownloadEnd: TDownloadEndEvent read FOnDownloadEnd write FOnDownloadEnd;
66 property OnDownloadMsg: TDownloadMsgEvent read FOnDownloadMsg write FOnDownloadMsg;
67 end;
68
69 TDownloadItem = class(TObject)
70 private
71 FDownType: TGikoDownloadType;
72 FBoard: TBoard;
73 FThreadItem: TThreadItem;
74
75 FContentLength: Integer;
76 FLastModified: TDateTime;
77 FContent: string;
78 FResponseCode: Smallint;
79 FState: TGikoDownloadState;
80 FErrText: string;
81 public
82 procedure SaveListFile;
83 procedure SaveItemFile;
84
85 property DownType: TGikoDownloadType read FDownType write FDownType;
86 property Board: TBoard read FBoard write FBoard;
87 property ThreadItem: TThreadItem read FThreadItem write FThreadItem;
88
89 property ContentLength: Integer read FContentLength write FContentLength;
90 property LastModified: TDateTime read FLastModified write FLastModified;
91 property Content: string read FContent write FContent;
92 property ResponseCode: Smallint read FResponseCode write FResponseCode;
93 property State: TGikoDownloadState read FState write FState;
94 property ErrText: string read FErrText write FErrText;
95 end;
96
97 implementation
98
99 constructor TDownloadThread.Create(CreateSuspended: Boolean);
100 begin
101 inherited Create(CreateSuspended);
102 FIndy := TIdHttp.Create(nil);
103
104 FIndy.OnWorkBegin := WorkBegin;
105 FIndy.OnWorkEnd := WorkEnd;
106 FIndy.OnWork := Work;
107 end;
108
109 destructor TDownloadThread.Destroy;
110 begin
111 FIndy.Free;
112 inherited;
113 end;
114
115 function RFC1123_Date(aDate : TDateTime) : String;
116 const
117 StrWeekDay : String = 'MonTueWedThuFriSatSun';
118 StrMonth : String = 'JanFebMarAprMayJunJulAugSepOctNovDec';
119 var
120 Year, Month, Day : Word;
121 Hour, Min, Sec, MSec : Word;
122 DayOfWeek : Word;
123 begin
124 DecodeDate(aDate, Year, Month, Day);
125 DecodeTime(aDate, Hour, Min, Sec, MSec);
126 DayOfWeek := ((Trunc(aDate) - 2) mod 7);
127 Result := Copy(StrWeekDay, 1 + DayOfWeek * 3, 3) + ', ' +
128 Format('%2.2d %s %4.4d %2.2d:%2.2d:%2.2d',
129 [Day, Copy(StrMonth, 1 + 3 * (Month - 1), 3),
130 Year, Hour, Min, Sec]);
131 end;
132
133 procedure TDownloadThread.Execute;
134 var
135 ResStream: TMemoryStream;
136
137 URL: string;
138 CgiStatus: TCgiStatus;
139 Modified: TDateTime;
140 RangeStart: Integer;
141 AdjustLen: Integer;
142 Idx: Integer;
143 ATitle: string;
144 DownloadResult: Boolean;
145 Abone: Boolean;
146 begin
147 while not Terminated do begin
148 FAbort := False;
149 FIndy.Request.CustomHeaders.Clear;
150 FIndy.Response.Clear;
151 FIndy.Request.Clear;
152 FIndy.Request.UserAgent := GikoSys.GetUserAgent;
153 FIndy.RecvBufferSize := Gikosys.Setting.RecvBufferSize;
154 FIndy.ProxyParams.BasicAuthentication := False;
155 {$IFDEF DEBUG}
156 Writeln('------------------------------------------------------------');
157 {$ENDIF}
158 //FIndy.AllowCookies := False;
159 if GikoSys.Setting.ReadProxy then begin
160 if GikoSys.Setting.ProxyProtocol then
161 FIndy.ProtocolVersion := pv1_1
162 else
163 FIndy.ProtocolVersion := pv1_0;
164 FIndy.ProxyParams.ProxyServer := GikoSys.Setting.ReadProxyAddress;
165 FIndy.ProxyParams.ProxyPort := GikoSys.Setting.ReadProxyPort;
166 FIndy.ProxyParams.ProxyUsername := GikoSys.Setting.ReadProxyUserID;
167 FIndy.ProxyParams.ProxyPassword := GikoSys.Setting.ReadProxyPassword;
168 if GikoSys.Setting.ReadProxyUserID <> '' then
169 FIndy.ProxyParams.BasicAuthentication := True;
170 {$IFDEF DEBUG}
171 Writeln('�v���L�V��������');
172 Writeln('�z�X�g: ' + GikoSys.Setting.ReadProxyAddress);
173 Writeln('�|�[�g: ' + IntToStr(GikoSys.Setting.ReadProxyPort));
174 {$ENDIF}
175 end else begin
176 if GikoSys.Setting.Protocol then
177 FIndy.ProtocolVersion := pv1_1
178 else
179 FIndy.ProtocolVersion := pv1_0;
180 FIndy.ProxyParams.ProxyServer := '';
181 FIndy.ProxyParams.ProxyPort := 80;
182 FIndy.ProxyParams.ProxyUsername := '';
183 FIndy.ProxyParams.ProxyPassword := '';
184 {$IFDEF DEBUG}
185 Writeln('�v���L�V��������');
186 {$ENDIF}
187 end;
188
189 FIndy.Request.ContentRangeStart := 0;
190 FIndy.Request.LastModified := ZERO_DATE;
191 ResStream := TMemoryStream.Create;
192 try
193 try
194 //********************
195 //DAT or Subject����
196 //********************
197 Item.ResponseCode := 0;
198 RangeStart := 0;
199 AdjustLen := 0;
200 Modified := 0;
201 if Item.DownType = gdtBoard then begin
202 {$IFDEF DEBUG}
203 Writeln('Subject����');
204 Writeln('URL: ' + Item.Board.GetReadCgiURL);
205 Writeln('Modified: ' + FloatToStr(Item.Board.LastModified));
206 {$ENDIF}
207 URL := Item.Board.GetReadCgiURL;
208 Modified := Item.Board.LastModified;
209 end else if Item.DownType = gdtThread then begin
210 {$IFDEF DEBUG}
211 Writeln('DAT����');
212 Writeln('URL: ' + Item.ThreadItem.GetDatURL);
213 Writeln('Modified: ' + FloatToStr(Item.ThreadItem.LastModified));
214 {$ENDIF}
215 URL := Item.ThreadItem.GetDatURL;
216 Modified := Item.ThreadItem.LastModified;
217 if Item.ThreadItem.Size > 0 then begin
218 {$IFDEF DEBUG}
219 Writeln('RangeStart: ' + IntToStr(Item.ThreadItem.Size));
220 {$ENDIF}
221 //�����[���`�F�b�N�������P�o�C�g�O��������
222 RangeStart := Item.ThreadItem.Size;
223 AdjustLen := -1;
224 end;
225 end;
226 Abone := False;
227 DownloadResult := DatDownload(Item.DownType, URL, Modified, RangeStart, AdjustLen);
228 {$IFDEF DEBUG}
229 Writeln('ResponseCode: ' + IntToStr(FIndy.ResponseCode));
230 {$ENDIF}
231 if Item.DownType = gdtThread then begin
232 if Item.ResponseCode = 416 then begin
233 Abone := True;
234 DownloadResult := True;
235 end else if DownloadResult and (AdjustLen = -1) and (Item.Content[1] <> #10) then
236 Abone := True;
237 end;
238
239 if Trim(FIndy.Response.RawHeaders.Values['Date']) <> '' then begin
240 if Item.DownType = gdtBoard then
241 Item.Board.LastGetTime := MonaUtils.DateStrToDateTime(FIndy.Response.RawHeaders.Values['Date'])
242 else
243 Item.ThreadItem.ParentBoard.LastGetTime := MonaUtils.DateStrToDateTime(FIndy.Response.RawHeaders.Values['Date']);
244 end;
245
246 if DownloadResult then begin
247 {$IFDEF DEBUG}
248 Writeln('Date:' + FIndy.Response.RawHeaders.Values['Date']);
249 {$ENDIF}
250 if Abone then begin
251 {$IFDEF DEBUG}
252 Writeln('�����[�����o');
253 {$ENDIF}
254 ATitle := Item.ThreadItem.Title;
255 if ATitle = '' then
256 ATitle := '�i�����s���j';
257 //�������������P�o�C�g����LF�������������u�����[���v������������������������������
258 RangeStart := 0;
259 AdjustLen := 0;
260 FMsg := '���u�����[���v�����o�����������������s������ - [' + ATitle + ']';
261 FIcon := gmiWhat;
262 if Assigned(OnDownloadMsg) then
263 Synchronize(FireDownloadMsg);
264 if not DatDownload(Item.DownType, URL, ZERO_DATE, RangeStart, AdjustLen) then
265 Item.State := gdsError;
266 {$IFDEF DEBUG}
267 Writeln('�����[����������');
268 Writeln('ResponseCode: ' + IntToStr(Item.ResponseCode));
269 {$ENDIF}
270 end else if (Item.DownType = gdtThread) and (AdjustLen = -1) and (Item.Content[1] = #10) then begin
271 //�������������P�o�C�g����LF�������i���������j������LF������
272 Item.Content := Copy(Item.Content, 2, Length(Item.Content));
273 end;
274 end else begin
275 Item.State := gdsError;
276 if (Item.DownType = gdtBoard) and (Item.ResponseCode = 302) then begin
277 FMsg := '�����������]�����������������������X�V���s����������������';
278 FIcon := gmiNG;
279 if Assigned(OnDownloadMsg) then
280 Synchronize(FireDownloadMsg);
281 end;
282 end;
283
284 //********************
285 //dat.gz����(1)
286 //********************
287 if (Item.DownType = gdtThread) and (Item.ResponseCode = 302) then begin
288 {$IFDEF DEBUG}
289 Writeln('dat.gz����');
290 {$ENDIF}
291 ATitle := Item.ThreadItem.Title;
292 if ATitle = '' then
293 ATitle := '�i�����s���j';
294 FMsg := '��dat�����������������������O(dat.gz)���T������ - [' + ATitle + ']';
295 FIcon := gmiWhat;
296 if Assigned(OnDownloadMsg) then
297 Synchronize(FireDownloadMsg);
298 URL := Item.ThreadItem.GetDatgzURL;
299 Modified := Item.ThreadItem.LastModified;
300 RangeStart := 0;
301 AdjustLen := 0;
302 if not DatDownload(Item.DownType, URL, Modified, RangeStart, AdjustLen) then
303 Item.State := gdsError;
304 {$IFDEF DEBUG}
305 Writeln('ResponseCode: ' + IntToStr(Item.ResponseCode));
306 {$ENDIF}
307 end;
308
309 //********************
310 //dat.gz����(2)
311 //********************
312 {
313 if (Item.DownType = gdtThread) and (Item.ResponseCode = 302) then begin
314 ATitle := Item.ThreadItem.Title;
315 if ATitle = '' then
316 ATitle := '�i�����s���j';
317 FMsg := '���������O(1)�����������������������O(2)�����T������ - [' + ATitle + ']';
318 FIcon := gmiWhat;
319 if Assigned(OnDownloadMsg) then
320 Synchronize(FireDownloadMsg);
321 URL := Item.ThreadItem.GetOldDatgzURL;
322 Modified := Item.ThreadItem.LastModified;
323 RangeStart := 0;
324 AdjustLen := 0;
325 if not DatDownload(Item.DownType, URL, Modified, RangeStart, AdjustLen) then
326 Item.State := gdsError;
327 end;
328 }
329
330 //********************
331 //offlaw.cgi������
332 //********************
333 FSessionID := '';
334 Synchronize(GetSessionID);
335 if (Item.DownType = gdtThread) and (Item.ResponseCode = 302) and (FSessionID <> '') then begin
336 {$IFDEF DEBUG}
337 Writeln('offlaw.cgi������');
338 {$ENDIF}
339 ATitle := Item.ThreadItem.Title;
340 if ATitle = '' then
341 ATitle := '�i�����s���j';
342 FMsg := '��dat.gz����������������offlaw.cgi�����p������ - [' + ATitle + ']';
343 FIcon := gmiWhat;
344 if Assigned(OnDownloadMsg) then
345 Synchronize(FireDownloadMsg);
346 URL := Item.ThreadItem.GetOfflawCgiURL(FSessionID);
347 Modified := Item.ThreadItem.LastModified;
348 RangeStart := 0;
349 AdjustLen := 0;
350 if not DatDownload(Item.DownType, URL, Modified, RangeStart, AdjustLen) then begin
351 {$IFDEF DEBUG}
352 Writeln('ResponseCode: ' + IntToStr(Item.ResponseCode));
353 {$ENDIF}
354 Item.State := gdsError;
355
356 if (Item.DownType = gdtThread) and (Item.ResponseCode = 302) then begin
357 FMsg := '�������]�����������������������X�V���s�������������B';
358 FIcon := gmiNG;
359 if Assigned(OnDownloadMsg) then
360 Synchronize(FireDownloadMsg);
361 end;
362
363 end else begin
364 CgiStatus := ParseCgiStatus(Item.Content);
365 {$IFDEF DEBUG}
366 Writeln('ResponseCode: ' + IntToStr(Item.ResponseCode));
367 {$ENDIF}
368 case CgiStatus.FStatus of
369 gcsOK: begin
370 {$IFDEF DEBUG}
371 Writeln('CGIStatus: OK');
372 {$ENDIF}
373 Item.ResponseCode := 200;
374 Item.Content := DeleteStatusLine(Item.Content);
375 Item.ContentLength := CgiStatus.FSize;
376 end;
377 gcsINCR: begin
378 //��������������
379 {$IFDEF DEBUG}
380 Writeln('CGIStatus: 206');
381 {$ENDIF}
382 Item.ResponseCode := 206;
383 Item.Content := DeleteStatusLine(Item.Content);
384 Item.ContentLength := CgiStatus.FSize;
385 end;
386 gcsERR: begin
387 {$IFDEF DEBUG}
388 Writeln('CGIStatus: 404(ERROR)');
389 {$ENDIF}
390 Item.ResponseCode := 404;
391 Item.State := gdsError;
392 Item.ErrText := CgiStatus.FErrText;
393 end;
394 end;
395 if (Item.ResponseCode = 404) and (AnsiPos('�������O�q��������', Item.ErrText) <> 0) then begin
396 {$IFDEF DEBUG}
397 Writeln('�������O����');
398 {$ENDIF}
399 ATitle := Item.ThreadItem.Title;
400 if ATitle = '' then
401 ATitle := '�i�����s���j';
402 FMsg := '���������O�q�������� - [' + ATitle + ']';
403 FIcon := gmiWhat;
404 if Assigned(OnDownloadMsg) then
405 Synchronize(FireDownloadMsg);
406 Idx := Pos(' ', Item.ErrText);
407 if Idx <> 0 then begin
408 URL := Copy(Item.ErrText, Idx + 1, Length(Item.ErrText));
409 if Pos('../', URL) = 1 then
410 URL := Copy(URL, 4, Length(URL));
411 URL := GikoSys.UrlToServer(Item.ThreadItem.ParentBoard.URL) + URL;
412 Modified := Item.ThreadItem.LastModified;
413 RangeStart := 0;
414 AdjustLen := 0;
415 if not DatDownload(Item.DownType, URL, Modified, RangeStart, AdjustLen) then
416 Item.State := gdsError;
417 {$IFDEF DEBUG}
418 Writeln('ResponseCode: ' + IntToStr(Item.ResponseCode));
419 {$ENDIF}
420 end;
421 end;
422 end;
423 end else begin
424 if (Item.DownType = gdtThread) and (Item.ResponseCode = 302) and (FSessionID = '') then begin
425 {$IFDEF DEBUG}
426 Writeln('���O�C�����������������������O�����s��');
427 {$ENDIF}
428 ATitle := Item.ThreadItem.Title;
429 if ATitle = '' then
430 ATitle := '�i�����s���j';
431 FMsg := '�����O�C�������������������T���������o�������� - [' + ATitle + ']';
432 FIcon := gmiSAD;
433 if Assigned(OnDownloadMsg) then
434 Synchronize(FireDownloadMsg);
435 end;
436 end;
437
438 case Item.ResponseCode of
439 200: Item.State := gdsComplete;
440 206: Item.State := gdsDiffComplete;
441 304: Item.State := gdsNotModify;
442 else
443 Item.State := gdsError;
444 end;
445 {
446 //�������v�������B�B�B
447 if (Item.ResponseCode in [200, 206]) and (Item.Content = '') then
448 Item.State := gdsError;
449 Item.LastModified := FIndy.Response.LastModified;
450 //�����������P�o�C�g�O���������������������}CiX����
451 Item.ContentLength := FIndy.Response.ContentLength + AdjustLen;
452 try
453 ResStream.Clear;
454 FIndy.Get(URL, ResStream);
455 Item.Content := GikoSys.GzipDecompress(ResStream, FIndy.Response.ContentEncoding);
456 if (Item.DownType = gdtThread) and (AdjustLen = -1) and (Item.Content[1] <> #10) then begin
457 //�������������P�o�C�g����LF�������������u�����[���v������������������������������
458 //���������b�Z�[�W�\���C�x���g
459 //event
460 FMsg := '�u�����[���v�����o�����������������s������';
461 if Assigned(OnDownloadMsg) then
462 Synchronize(FireDownloadMsg);
463 FIndy.Request.ContentRangeStart := 0;
464 FIndy.Request.ContentRangeEnd := 0;
465 AdjustLen := 0;
466 ResStream.Clear;
467 FIndy.Get(URL, ResStream);
468 Item.Content := GikoSys.GzipDecompress(ResStream, FIndy.Response.ContentEncoding);
469 end else if (Item.DownType = gdtThread) and (AdjustLen = -1) and (Item.Content[1] = #10) then begin
470 //�������������P�o�C�g����LF�������i���������j������LF������
471 Item.Content := Copy(Item.Content, 2, Length(Item.Content));
472 end;
473 except
474 Item.State := gdsError;
475 end;
476 Item.ResponseCode := FIndy.ResponseCode;
477 }
478 {
479 try
480 ResStream.Clear;
481 FIndy.Get(URL, ResStream);
482 Item.Content := GikoSys.GzipDecompress(ResStream, FIndy.Response.ContentEncoding);
483 except
484 Item.State := gdsError;
485 end;
486
487 CgiStatus := ParseCgiStatus(Item.Content);
488 if CgiStatus.FStatus = gcsOK then begin
489 if CgiStatus.FSize = 0 then
490 Item.State := gdsNotModify
491 else if Item.DownType = gdtBoard then
492 Item.State := gdsComplete
493 else
494 Item.State := gdsDiffComplete;
495 end else if CgiStatus.FStatus = gcsINCR then begin
496 Item.State := gdsComplete;
497 end else if CgiStatus.FStatus = gcsERR then begin
498 Item.State := gdsError;
499 Item.ErrText := CgiStatus.FErrText;
500 end;
501 Item.ContentLength := CgiStatus.FSize;
502 }
503 except
504 Item.State := gdsError;
505 end;
506 //Item.ResponseCode := FIndy.ResponseCode;
507 if FAbort then
508 Item.State := gdsAbort;
509 finally
510 if Assigned(OnDownloadEnd) then
511 Synchronize(FireDownloadEnd);
512 ResStream.Free;
513 end;
514 if Terminated then Break;
515 Suspend;
516 end;
517 end;
518
519 function TDownloadThread.DatDownload(ItemType: TGikoDownloadType; URL: string; Modified: TDateTime; RangeStart: Integer; AdjustLen: Integer): Boolean;
520 var
521 ResponseCode: Integer;
522 ResStream: TMemoryStream;
523 begin
524 ResponseCode := -1;
525 if (ItemType = gdtThread) and (RangeStart > 0) then begin
526 // if (ItemType = gdtThread) and (Item.ThreadItem.Size > 0) then begin
527 // FIndy.Request.ContentRangeStart := Item.ThreadItem.Size + AdjustLen;
528 FIndy.Request.ContentRangeStart := RangeStart + AdjustLen;
529 FIndy.Request.ContentRangeEnd := 0;
530 end else begin
531 FIndy.Request.ContentRangeStart := 0;
532 FIndy.Request.ContentRangeEnd := 0;
533 end;
534
535 FIndy.Request.CustomHeaders.Clear;
536 FIndy.Request.CacheControl := 'no-cache';
537 FIndy.Request.CustomHeaders.Add('Pragma: no-cache');
538 if (Modified <> 0) and (Modified <> ZERO_DATE) then begin
539 FIndy.Request.LastModified := modified - OffsetFromUTC;
540 //FIndy.Request.CustomHeaders.Add('If-Modified-Since: ' + RFC1123_Date(modified - OffsetFromUTC) + ' GMT');
541 end;
542 // FIndy.Request.AcceptEncoding := 'gzip';
543 if RangeStart = 0 then
544 FIndy.Request.AcceptEncoding := 'gzip'
545 else
546 FIndy.Request.AcceptEncoding := '';
547 ResStream := TMemoryStream.Create;
548 try
549 try
550 ResStream.Clear;
551 {$IFDEF DEBUG}
552 Writeln('URL: ' + URL);
553 {$ENDIF}
554 FIndy.Get(URL, ResStream);
555 Item.Content := GikoSys.GzipDecompress(ResStream, FIndy.Response.ContentEncoding);
556 Item.LastModified := FIndy.Response.LastModified;
557 //�����������P�o�C�g�O���������������������}�C�i�X����
558 // Item.ContentLength := FIndy.Response.ContentLength + AdjustLen;
559 Item.ContentLength := Length(Item.Content) + AdjustLen;
560 //�������v�������B�B�B
561 // if (FIndy.ResponseCode in [200, 206]) and (Item.Content = '') then
562 // Result := False
563 if Item.Content = '' then
564 Result := False
565 else
566 Result := True;
567 {$IFDEF DEBUG}
568 Writeln('���������O����');
569 {$ENDIF}
570 ResponseCode := FIndy.ResponseCode;
571 except
572 on E: EIdSocketError do begin
573 Item.Content := '';
574 Item.LastModified := ZERO_DATE;
575 Item.ContentLength := 0;
576 Item.ErrText := E.Message;
577 Result := False;
578 ResponseCode := -1;
579 end;
580 on E: EIdConnectException do begin
581 Item.Content := '';
582 Item.LastModified := ZERO_DATE;
583 Item.ContentLength := 0;
584 Item.ErrText := E.Message;
585 Result := False;
586 ResponseCode := -1;
587 end;
588 on E: Exception do begin
589 {$IFDEF DEBUG}
590 Writeln('���������O����');
591 Writeln('E.Message: ' + E.Message);
592 {$ENDIF}
593 Item.Content := '';
594 Item.LastModified := ZERO_DATE;
595 Item.ContentLength := 0;
596 Item.ErrText := E.Message;
597 ResponseCode := FIndy.ResponseCode;
598 Result := False;
599 end;
600 end;
601 finally
602 if (Item.ContentLength = 0) and (ResponseCode = 206) then
603 Item.ResponseCode := 304
604 else
605 Item.ResponseCode := ResponseCode;
606 ResStream.Free;
607 end;
608 end;
609
610 procedure TDownloadThread.FireDownloadEnd;
611 begin
612 OnDownloadEnd(self, Item);
613 end;
614
615 procedure TDownloadThread.FireDownloadMsg;
616 begin
617 OnDownloadMsg(Self, Item, FMsg, FIcon);
618 end;
619
620 procedure TDownloadThread.GetSessionID;
621 begin
622 FSessionID := GikoSys.Dolib.SessionID;
623 end;
624
625 procedure TDownloadThread.Abort;
626 begin
627 FAbort := True;
628 FIndy.DisconnectSocket;
629 end;
630
631 procedure TDownloadThread.WorkBegin(Sender: TObject; AWorkMode: TWorkMode; const AWorkCountMax: Integer);
632 begin
633 if Assigned(OnWorkBegin) then
634 OnWorkBegin(Sender, AWorkMode, AWorkCountMax, FNumber);
635 end;
636
637 procedure TDownloadThread.WorkEnd(Sender: TObject; AWorkMode: TWorkMode);
638 begin
639 if Assigned(OnWorkEnd) then
640 OnWorkEnd(Sender, AWorkMode, FNumber);
641 end;
642
643 procedure TDownloadThread.Work(Sender: TObject; AWorkMode: TWorkMode; const AWorkCount: Integer);
644 begin
645 if Assigned(OnWork) then
646 OnWork(Sender, AWorkMode, AWorkCount, FNumber);
647 end;
648
649 function TDownloadThread.ParseCgiStatus(Content: string): TCgiStatus;
650 var
651 StatusLine: string;
652 Line: string;
653 Idx: Integer;
654 Status: string;
655 Size: string;
656 Msg: string;
657 begin
658 // [+OK] ������������
659 // [-INCR] (Incorrect)�����������������f�[�^
660 // [-ERR (�e�L�X�g)]���������������G���[
661 // ���F+OK 23094/512K
662 // -INCR 23094/512K
663 // -ERR ����������������
664 Idx := AnsiPos(#10, Content);
665 StatusLine := Copy(Content, 0, Idx);
666
667 Idx := AnsiPos(' ', Content);
668 Status := Copy(StatusLine, 0, Idx - 1);
669 Line := Copy(StatusLine, Idx + 1, Length(StatusLine));
670
671 // Idx := AnsiPos('/', Line);
672 if Trim(Status) = '-ERR' then
673 Msg := Trim(Line)
674 else
675 Size := Copy(Line, 0, Idx - 1);
676
677 if Trim(Status) = '+OK' then
678 Result.FStatus := gcsOK
679 else if Trim(Status) = '-INCR' then
680 Result.FStatus := gcsINCR
681 else if Trim(Status) = '-ERR' then begin
682 Result.FStatus := gcsERR;
683 Result.FErrText := Msg;
684 Result.FSize := 0;
685 Exit;
686 end else begin
687 {$IFDEF DEBUG}
688 Writeln(Status);
689 {$ENDIF}
690 Result.FStatus := gcsERR;
691 Result.FErrText := '�G���[�����������A���������������G���[';
692 Result.FSize := 0;
693 Exit;
694 end;
695
696 if GikoSys.IsNumeric(Size) then
697 Result.FSize := StrToInt(Size)
698 else begin
699 Result.FSize := 0;
700 Result.FStatus := gcsERR;
701 Result.FErrText := '�X�e�[�^�X�������s[' + StatusLine + ']';
702 end;
703 end;
704
705 //��������������1�s��������
706 function TDownloadThread.DeleteStatusLine(Content: string): string;
707 var
708 SList: TStringList;
709 begin
710 SList := TStringList.Create;
711 try
712 SList.Text := Content;
713 if SList.Count > 1 then
714 SList.Delete(0);
715 Result := SList.Text;
716 finally
717 SList.Free;
718 end;
719 end;
720
721 procedure TDownloadItem.SaveListFile;
722 var
723 i: Integer;
724 index: Integer;
725 NewItem: TThreadItem;
726 NewList: TList;
727 // SaveCount: Integer;
728 NumCount: Integer;
729 Body: TStringList;
730 Rec: TSubjectRec;
731 begin
732 NewList := TList.Create;
733 Body := TStringList.Create;
734 try
735 //�_�E�����[�h���������i���[�J�������j
736 Board.RoundDate := Now;
737 //�T�[�o���t�@�C�����X�V��������
738 Board.LastModified := LastModified;
739
740 //�V�������X�g����������
741 //�V�������X�g���������X�g�����O�����������������V�������X�g������
742 //�������O�����������A�V�����X���I�u�W�F�N�g������
743 Body.Text := Content;
744 NumCount := 0;
745 for i := 0 to Body.Count - 1 do begin
746 //if i = 0 then Continue; //�P�s�����X�e�[�^�X�s��������������
747
748 Rec := GikoSys.DivideSubject(Body[i]);
749 Rec.FFileName := Trim(Rec.FFileName);
750 if (Rec.FTitle = '') and (Rec.FCount = 0) then Continue;
751 Inc(NumCount);
752 index := Board.GetIndex(Rec.FFileName);
753 if index = -1 then begin
754 //�V�����X���b�h
755 NewItem := TThreadItem.Create;
756 NewItem.FileName := Rec.FFileName;
757 NewItem.Title := Rec.FTitle;
758 // NewItem.Count := Rec.FCount;
759 NewItem.AllResCount := Rec.FCount;
760 NewItem.ParentBoard := Board;
761 NewItem.No := NumCount;
762 NewItem.RoundDate := ZERO_DATE;
763 NewItem.LastModified := ZERO_DATE;
764 NewItem.AgeSage := gasNew;
765 NewList.Add(NewItem);
766 end else begin
767 //Board.Items[index].Count := Count;
768 //Board.Items[index].Count := Rec.FCount;
769 if Board.Items[index].No > NumCount then
770 Board.Items[index].AgeSage := gasAge
771 else if Board.Items[index].AllResCount < Rec.FCount then
772 Board.Items[index].AgeSage := gasSage
773 else
774 Board.Items[index].AgeSage := gasNone;
775
776
777 Board.Items[index].No := NumCount;
778 Board.Items[index].AllResCount := Rec.FCount;
779 // if not Board.Items[index].IsLogFile then
780 // Board.Items[index].Count := Rec.FCount;
781 NewList.Add(Board.Items[index]);
782 Board.DeleteList(index);
783 end;
784 end;
785
786 //�V�������X�g�����������A�C�e�����V�������X�g������
787 for i := 0 to Board.Count - 1 do begin
788 if Board.Items[i].IsLogFile then begin
789 inc(NumCount);
790 Board.Items[i].No := NumCount;
791 Board.Items[i].AllResCount := Board.Items[i].Count;
792 Board.Items[i].NewResCount := 0;
793 Board.Items[i].AgeSage := gasNone;
794 NewList.Add(Board.Items[i]);
795 end;
796 end;
797
798 //�������X�g�������i���X�g�����B�X���I�u�W�F�N�g���������������j
799 for i := Board.Count - 1 downto 0 do
800 Board.DeleteList(i);
801
802 //�V�������X�g���{�[�h�I�u�W�F�N�g������
803 for i := 0 to NewList.Count - 1 do
804 Board.Add(TThreadItem(NewList[i]));
805
806 //���X�g(subject.txt)������
807 // GikoSys.ForceDirectoriesEx(GikoSys.GetLogDir + Board.BBSID);
808 // Body.SaveToFile(GikoSys.GetSubjectFileName(Board.BBSID));
809 GikoSys.ForceDirectoriesEx(ExtractFilePath(Board.GetSubjectFileName));
810 Body.SaveToFile(Board.GetSubjectFileName);
811 finally
812 Body.Free;
813 NewList.Free;
814 end;
815 end;
816
817 {procedure TDownloadItem.SaveListFile;
818 var
819 i: Integer;
820 index: Integer;
821 NewItem: TThreadItem;
822 NewList: TList;
823 // SaveCount: Integer;
824 NumCount: Integer;
825 Body: TStringList;
826 Rec: TSubjectRec;
827 begin
828 NewList := TList.Create;
829 Body := TStringList.Create;
830 try
831 //������������
832 Board.RoundDate := Now;
833 //�T�[�o���t�@�C�����X�V��������
834 Board.LastModified := LastModified;
835
836 //���X�g������������
837 //SaveCount := MaxInt;
838
839 //�������X�g�������O�����A�C�e��������
840 for i := Board.Count - 1 downto 0 do
841 if not Board.Items[i].IsLogFile then
842 Board.Delete(i);
843
844 //�V�������X�g����������
845 //�V�������X�g���������X�g�����O�����������������V�������X�g������
846 //�������O�����������A�V�����X���I�u�W�F�N�g������
847 Body.Text := Content;
848 // Loop := Min(Body.Count, SaveCount);
849 NumCount := 0;
850 // for i := 0 to Loop - 1 do begin
851 for i := 0 to Body.Count - 1 do begin
852 if i = 0 then Continue; //�P�s�����X�e�[�^�X�s��������������
853
854 Rec := GikoSys.DivideSubject(Body[i]);
855 if (Rec.FTitle = '') and (Rec.FCount = 0) then Continue;
856 Inc(NumCount);
857 index := Board.GetIndex(Rec.FFileName);
858 if index = -1 then begin
859 NewItem := TThreadItem.Create;
860 NewItem.FileName := Rec.FFileName;
861 NewItem.Title := Rec.FTitle;
862 NewItem.Count := Rec.FCount;
863 NewItem.ParentBoard := Board;
864 NewItem.No := NumCount;
865 NewItem.RoundDate := ZERO_DATE;
866 NewItem.LastModified := ZERO_DATE;
867 NewList.Add(NewItem);
868 end else begin
869 //Board.Items[index].Count := Count;
870 Board.Items[index].No := NumCount;
871 NewList.Add(Board.Items[index]);
872 Board.DeleteList(index);
873 end;
874 end;
875
876 //�V�������X�g�����������������O�L���A�C�e�����V�������X�g������
877 for i := 0 to Board.Count - 1 do begin
878 inc(NumCount);
879 Board.Items[i].No := NumCount;
880 NewList.Add(Board.Items[i]);
881 end;
882
883 //�������X�g�������i���X�g�����B�X���I�u�W�F�N�g���������������j
884 for i := Board.Count - 1 downto 0 do
885 Board.DeleteList(i);
886
887 //�V�������X�g���{�[�h�I�u�W�F�N�g������
888 for i := 0 to NewList.Count - 1 do
889 Board.Add(TThreadItem(NewList[i]));
890
891 //���X�g(subject.txt)������
892 // GikoSys.ForceDirectoriesEx(GikoSys.GetLogDir + Board.BBSID);
893 // Body.SaveToFile(GikoSys.GetSubjectFileName(Board.BBSID));
894 GikoSys.ForceDirectoriesEx(ExtractFilePath(Board.GetSubjectFileName));
895 Body.SaveToFile(Board.GetSubjectFileName);
896 finally
897 Body.Free;
898 NewList.Free;
899 end;
900 end;
901 }
902 procedure TDownloadItem.SaveItemFile;
903 var
904 Body: TStringList;
905 Cnt: Integer;
906 OldCnt: Integer;
907 FileName: string;
908 ini: TMemIniFile;
909 Res: TResRec;
910 NewRes: Integer;
911 begin
912 if Trim(Content) = '' then
913 Exit;
914 FileName := ThreadItem.GetThreadFileName;
915 GikoSys.ForceDirectoriesEx(ExtractFilePath(FileName));
916
917 // Cnt := 0;
918 Body := TStringList.Create;
919 try
920 // if FileExists(FileName) and (ResponseCode = 206) then begin
921 if FileExists(FileName) and (State = gdsDiffComplete) then begin
922 // Body.Text := Content;
923 // if Body.Count > 0 then
924 // Body.Delete(0);
925 // Content := Body.Text;
926 Body.LoadFromFile(FileName);
927 OldCnt := Body.Count;
928 Body.Text := Body.Text + Content;
929 Body.SaveToFile(FileName);
930 NewRes := Body.Count - OldCnt;
931 Cnt := Body.Count;
932 end else begin
933 Body.Text := Content;
934 // if Body.Count > 0 then
935 // Body.Delete(0);
936 Body.SaveToFile(FileName);
937
938 if ThreadItem.Title = '' then begin
939 Res := GikoSys.DivideStrLine(Body[0]);
940 ThreadItem.Title := Res.FTitle;
941 end;
942 ThreadItem.Size := 0;
943 //ThreadItem.Count := 0;
944 ThreadItem.AllResCount := 0;
945 ThreadItem.NewResCount := 0;
946 OldCnt := 0;
947 NewRes := Body.Count;
948 Cnt := Body.Count;
949 end;
950 Cnt := Body.Count;
951 finally
952 Body.Free;
953 end;
954 ThreadItem.RoundDate := Now;
955 ThreadItem.Size := ThreadItem.Size + ContentLength;
956 ThreadItem.LastModified := LastModified;
957 ThreadItem.Count := Cnt;
958 ThreadItem.AllResCount := Cnt;
959 ThreadItem.NewResCount := NewRes;
960 ThreadItem.IsLogFile := True;
961 ThreadItem.NewReceive := OldCnt + 1;
962 ThreadItem.UnRead := True;
963 ThreadItem.ParentBoard.UnRead := ThreadItem.ParentBoard.UnRead + 1;
964 // if ThreadItem.RoundNo = 6 then
965 // ThreadItem.RoundNo := 0;
966
967 //�����I�������C���f�b�N�X���X�V�������������A�e���|���������������B
968 //�����I������������
969 //�����I�������A�����N�������e���|�����������X�V
970 ini := TMemIniFile.Create(ChangeFileExt(FileName, '.tmp'));
971 try
972 ini.WriteDateTime('Setting', 'RoundDate', ThreadItem.RoundDate);
973 ini.WriteDateTime('Setting', 'LastModified', ThreadItem.LastModified);
974 ini.WriteInteger('Setting', 'Size', ThreadItem.Size);
975 ini.WriteInteger('Setting', 'Count', ThreadItem.Count);
976 ini.WriteInteger('Setting', 'AllResCount', ThreadItem.AllResCount);
977 ini.WriteInteger('Setting', 'NewResCount', ThreadItem.NewResCount);
978 ini.WriteInteger('Setting', 'NewReceive', ThreadItem.NewReceive);
979 // ini.WriteInteger('Setting', 'RoundNo', ThreadItem.RoundNo);
980 ini.WriteBool('Setting', 'Round', ThreadItem.Round);
981 ini.WriteBool('Setting', 'UnRead', ThreadItem.UnRead);
982 ini.UpdateFile;
983 finally
984 ini.Free;
985 end;
986 end;
987
988 end.

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