bottleclient/HttpThread.pas

   1 unit HttpThread;
   2
   3 interface
   4
   5 uses
   6   Classes, IdHttp, IdException, SysUtils, Dialogs, IdComponent;
   7
   8 type
   9   THttpWorkEvent = procedure(Sender: TObject; LoadBytes: integer) of object;
  10
  11   THTTPDownloadThread = class(TThread)
  12   private
  13     { Private \90é\8c¾ }
  14     FHost: String;
  15     FURL: String;
  16     FPost: String;
  17     FRecvString: String;
  18     FProxyServer: String;
  19     FProxyPort: integer;
  20     FProxyUser: String;
  21     FProxyPass: String;
  22     FOnSuccess: TNotifyEvent;
  23     FOnConnectionFailed: TNotifyEvent;
  24     FLastErrorMessage: String;
  25     FOnHttpWork: THttpWorkEvent;
  26     FLoadBytes: integer;
  27     FLastTriggeredLoadBytes: integer;
  28     FTriggerWorkEventBy: integer;
  29     procedure SetProxyPort(const Value: integer);
  30     procedure SetProxyServer(const Value: String);
  31     procedure SetProxyUser(const Value: String);
  32     procedure SetProxyPass(const Value: String);
  33     procedure SetOnConnectionFailed(const Value: TNotifyEvent);
  34     procedure SetOnSuccess(const Value: TNotifyEvent);
  35     procedure SetOnHttpWork(const Value: THttpWorkEvent);
  36     procedure WorkHandler(Sender: TObject; AWorkMode: TWorkMode;
  37       const AWorkCount: Integer);
  38     procedure SetTriggerWorkEventBy(const Value: integer);
  39   protected
  40     procedure Execute; override;
  41     procedure DoSuccess;
  42     procedure DoConnectionFailed;
  43     procedure DoHttpWork;
  44   public
  45     constructor Create(const Host, URL, Post: String); reintroduce;
  46     property RecvString: String read FRecvString;
  47     property ProxyServer: String read FProxyServer write SetProxyServer;
  48     property ProxyPort: integer read FProxyPort write SetProxyPort;
  49     property ProxyUser: String read FProxyUser write SetProxyUser;
  50     property ProxyPass: String read FProxyPass write SetProxyPass;
  51     property OnConnectionFailed: TNotifyEvent read FOnConnectionFailed write SetOnConnectionFailed;
  52     property OnSuccess: TNotifyEvent read FOnSuccess write SetOnSuccess;
  53     property OnHttpWork: THttpWorkEvent read FOnHttpWork write SetOnHttpWork;
  54     property LastErrorMessage: String read FLastErrorMessage;
  55     property TriggerWorkEventBy: integer read FTriggerWorkEventBy write SetTriggerWorkEventBy;
  56   end;
  57
  58 implementation
  59
  60 {\92\8d\88Ó:
  61   \88Ù\82È\82é\83X\83\8c\83b\83h\82ª\8f\8a\97L\82·\82é VCL \82Ì\83\81\83\\83b\83h/\8aÖ\90\94/\83v\83\8d\83p\83e\83B\82ð
  62   \95Ê\82Ì\83X\83\8c\83b\83h\82Ì\92\86\82©\82ç\88µ\82¤\8fê\8d\87\81A\94r\91¼\8f\88\97\9d\82Ì\96â\91è\82ª\94\90¶\82µ\82Ü\82·\81B
  63
  64   \83\81\83C\83\93\83X\83\8c\83b\83h\82Ì\8f\8a\97L\82·\82é\83I\83u\83W\83F\83N\83g\82É\91Î\82µ\82Ä\82Í Synchronize
  65   \83\81\83\\83b\83h\82ð\8eg\82¤\8e\96\82ª\82Å\82«\82Ü\82·\81B\91¼\82Ì\83I\83u\83W\83F\83N\83g\82ð\8eQ\8fÆ\82·\82é\82½\82ß
  66   \82Ì\83\81\83\\83b\83h\82ð\83X\83\8c\83b\83h\83N\83\89\83X\82É\92Ç\89Á\82µ\81ASynchronize \83\81\83\\83b\83h\82Ì
  67   \88ø\90\94\82Æ\82µ\82Ä\93n\82µ\82Ü\82·\81B
  68
  69   \82½\82Æ\82¦\82Î\81AUpdateCaption \83\81\83\\83b\83h\82ð\88È\89º\82Ì\82æ\82¤\82É\92è\8b`\82µ\81A
  70
  71     procedure THTTPDownloadThread.UpdateCaption;
  72     begin
  73       Form1.Caption := 'THTTPDownloadThread \83X\83\8c\83b\83h\82©\82ç\8f\91\82«\8a·\82¦\82Ü\82µ\82½';
  74     end;
  75
  76   Execute \83\81\83\\83b\83h\82Ì\92\86\82Å Synchronize \83\81\83\\83b\83h\82É\93n\82·\82±\82Æ\82Å\83\81\83C
  77   \83\93\83X\83\8c\83b\83h\82ª\8f\8a\97L\82·\82é Form1 \82Ì Caption \83v\83\8d\83p\83e\83B\82ð\88À\91S\82É\95Ï
  78   \8dX\82Å\82«\82Ü\82·\81B
  79
  80       Synchronize(UpdateCaption);
  81 }
  82
  83 { THTTPDownloadThread }
  84
  85 constructor THTTPDownloadThread.Create(const Host, URL, Post: String);
  86 begin
  87   inherited Create(true);
  88   FHost := Host;
  89   FURL := URL;
  90   FPost := Post;
  91   FTriggerWorkEventBy := 1024; // KB\92P\88Ê\82ÅOnHttpWork\83C\83x\83\93\83g\94\90¶
  92 end;
  93
  94 procedure THTTPDownloadThread.DoConnectionFailed;
  95 begin
  96   FOnConnectionFailed(self);
  97 end;
  98
  99 procedure THTTPDownloadThread.DoHttpWork;
 100 begin
 101   FOnHttpWork(self, FLoadBytes);
 102 end;
 103
 104 procedure THTTPDownloadThread.DoSuccess;
 105 begin
 106   FOnSuccess(self);
 107 end;
 108
 109 procedure THTTPDownloadThread.Execute;
 110 var Http: TIdHTTP;
 111     TmpStr: TStringStream;
 112 begin
 113   Http := nil;
 114   TmpStr := nil;
 115   FLoadBytes := 0;
 116   FLastTriggeredLoadBytes := 0;
 117   try
 118     try
 119       Http := TIdHTTP.Create(nil);
 120       Http.Host := FHost;
 121       Http.ProxyParams.ProxyServer := ProxyServer;
 122       Http.ProxyParams.ProxyPort := ProxyPort;
 123
 124       if ProxyUser <> '' then begin
 125         if ProxyPass <> '' then begin
 126           Http.ProxyParams.BasicAuthentication := true;
 127           Http.ProxyParams.ProxyUsername := ProxyUser;
 128           Http.ProxyParams.ProxyPassword := ProxyPass;
 129         end;
 130       end;
 131
 132       Http.OnWork := WorkHandler;
 133       if FPost = '' then begin
 134         FRecvString := Http.Get(FURL);
 135       end else begin
 136         TmpStr := TStringStream.Create(FPost);
 137         FRecvString := Http.Post(FURL, TmpStr);
 138       end;
 139       if Assigned(FOnSuccess) then Synchronize(DoSuccess);
 140     except
 141       on E:EIdException do begin
 142         //ShowMessage(E.Message);
 143         FLastErrorMessage := E.Message;
 144         if Assigned(FOnConnectionFailed) then Synchronize(DoConnectionFailed);
 145       end;
 146     end;
 147   finally
 148     Http.Free;
 149     if TmpStr <> nil then TmpStr.Free;
 150   end;
 151 end;
 152
 153 procedure THTTPDownloadThread.SetOnConnectionFailed(
 154   const Value: TNotifyEvent);
 155 begin
 156   FOnConnectionFailed := Value;
 157 end;
 158
 159 procedure THTTPDownloadThread.SetOnHttpWork(const Value: THttpWorkEvent);
 160 begin
 161   FOnHttpWork := Value;
 162 end;
 163
 164 procedure THTTPDownloadThread.SetOnSuccess(const Value: TNotifyEvent);
 165 begin
 166   FOnSuccess := Value;
 167 end;
 168
 169 procedure THTTPDownloadThread.SetProxyPort(const Value: integer);
 170 begin
 171   if Suspended then
 172     FProxyPort := Value
 173   else
 174     raise EIdException.Create('Tried to change proxy without suspending');
 175 end;
 176
 177 procedure THTTPDownloadThread.SetProxyServer(const Value: String);
 178 begin
 179   if Suspended then
 180     FProxyServer := Value
 181   else
 182     raise EIdException.Create('Tried to change proxy without suspending');
 183 end;
 184
 185 procedure THTTPDownloadThread.SetProxyUser(const Value: String);
 186 begin
 187   if Suspended then
 188     FProxyUser := Value
 189   else
 190     raise EIdException.Create('Tried to change proxy without suspending');
 191 end;
 192
 193 procedure THTTPDownloadThread.SetProxyPass(const Value: String);
 194 begin
 195   if Suspended then
 196     FProxyPass := Value
 197   else
 198     raise EIdException.Create('Tried to change proxy without suspending');
 199 end;
 200
 201 procedure THTTPDownloadThread.SetTriggerWorkEventBy(const Value: integer);
 202 begin
 203   FTriggerWorkEventBy := Value;
 204 end;
 205
 206 procedure THTTPDownloadThread.WorkHandler(Sender: TObject;
 207   AWorkMode: TWorkMode; const AWorkCount: Integer);
 208 begin
 209   if AWorkMode = wmRead then
 210     //Inc(FLoadBytes, AWorkCount);
 211     FLoadBytes := AWorkCount;
 212   if (FLastTriggeredLoadBytes div FTriggerWorkEventBy) <>
 213   (FLoadBytes div FTriggerWorkEventBy) then begin
 214     if Assigned(FOnHttpWork) then Synchronize(DoHttpWork);
 215     FLastTriggeredLoadBytes := FLoadBytes;
 216   end;
 217 end;
 218
 219 end.