Develop and Download Open Source Software

Browse CVS Repository

Annotation of /gikonavigoeson/gikonavi/ItemDownload.pas

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


Revision 1.1 - (hide 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 hi_ 1.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