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     FOnSuccess: TNotifyEvent;
  21     FOnConnectionFailed: TNotifyEvent;
  22     FLastErrorMessage: String;
  23     FOnHttpWork: THttpWorkEvent;
  24     FLoadBytes: integer;
  25     FLastTriggeredLoadBytes: integer;
  26     FTriggerWorkEventBy: integer;
  27     procedure SetProxyPort(const Value: integer);
  28     procedure SetProxyServer(const Value: String);
  29     procedure SetOnConnectionFailed(const Value: TNotifyEvent);
  30     procedure SetOnSuccess(const Value: TNotifyEvent);
  31     procedure SetOnHttpWork(const Value: THttpWorkEvent);
  32     procedure WorkHandler(Sender: TObject; AWorkMode: TWorkMode;
  33       const AWorkCount: Integer);
  34     procedure SetTriggerWorkEventBy(const Value: integer);
  35   protected
  36     procedure Execute; override;
  37     procedure DoSuccess;
  38     procedure DoConnectionFailed;
  39     procedure DoHttpWork;
  40   public
  41     constructor Create(const Host, URL, Post: String); reintroduce;
  42     property RecvString: String read FRecvString;
  43     property ProxyServer: String read FProxyServer write SetProxyServer;
  44     property ProxyPort: integer read FProxyPort write SetProxyPort;
  45     property OnConnectionFailed: TNotifyEvent read FOnConnectionFailed write SetOnConnectionFailed;
  46     property OnSuccess: TNotifyEvent read FOnSuccess write SetOnSuccess;
  47     property OnHttpWork: THttpWorkEvent read FOnHttpWork write SetOnHttpWork;
  48     property LastErrorMessage: String read FLastErrorMessage;
  49     property TriggerWorkEventBy: integer read FTriggerWorkEventBy write SetTriggerWorkEventBy;
  50   end;
  51
  52 implementation
  53
  54 {\92\8d\88Ó:
  55   \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ð
  56   \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
  57
  58   \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
  59   \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ß
  60   \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Ì
  61   \88ø\90\94\82Æ\82µ\82Ä\93n\82µ\82Ü\82·\81B
  62
  63   \82½\82Æ\82¦\82Î\81AUpdateCaption \83\81\83\\83b\83h\82ð\88È\89º\82Ì\82æ\82¤\82É\92è\8b`\82µ\81A
  64
  65     procedure THTTPDownloadThread.UpdateCaption;
  66     begin
  67       Form1.Caption := 'THTTPDownloadThread \83X\83\8c\83b\83h\82©\82ç\8f\91\82«\8a·\82¦\82Ü\82µ\82½';
  68     end;
  69
  70   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
  71   \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Ï
  72   \8dX\82Å\82«\82Ü\82·\81B
  73
  74       Synchronize(UpdateCaption);
  75 }
  76
  77 { THTTPDownloadThread }
  78
  79 constructor THTTPDownloadThread.Create(const Host, URL, Post: String);
  80 begin
  81   inherited Create(true);
  82   FHost := Host;
  83   FURL := URL;
  84   FPost := Post;
  85   FTriggerWorkEventBy := 1024; // KB\92P\88Ê\82ÅOnHttpWork\83C\83x\83\93\83g\94\90¶
  86 end;
  87
  88 procedure THTTPDownloadThread.DoConnectionFailed;
  89 begin
  90   FOnConnectionFailed(self);
  91 end;
  92
  93 procedure THTTPDownloadThread.DoHttpWork;
  94 begin
  95   FOnHttpWork(self, FLoadBytes);
  96 end;
  97
  98 procedure THTTPDownloadThread.DoSuccess;
  99 begin
 100   FOnSuccess(self);
 101 end;
 102
 103 procedure THTTPDownloadThread.Execute;
 104 var Http: TIdHTTP;
 105     TmpStr: TStringStream;
 106 begin
 107   Http := nil;
 108   TmpStr := nil;
 109   FLoadBytes := 0;
 110   FLastTriggeredLoadBytes := 0;
 111   try
 112     try
 113       Http := TIdHTTP.Create(nil);
 114       Http.Host := FHost;
 115       Http.ProxyParams.ProxyServer := ProxyServer;
 116       Http.ProxyParams.ProxyPort := ProxyPort;
 117       Http.OnWork := WorkHandler;
 118       if FPost = '' then begin
 119         FRecvString := Http.Get(FURL);
 120       end else begin
 121         TmpStr := TStringStream.Create(FPost);
 122         FRecvString := Http.Post(FURL, TmpStr);
 123       end;
 124       if Assigned(FOnSuccess) then Synchronize(DoSuccess);
 125     except
 126       on E:EIdException do begin
 127         //ShowMessage(E.Message);
 128         FLastErrorMessage := E.Message;
 129         if Assigned(FOnConnectionFailed) then Synchronize(DoConnectionFailed);
 130       end;
 131     end;
 132   finally
 133     Http.Free;
 134     if TmpStr <> nil then TmpStr.Free;
 135   end;
 136 end;
 137
 138 procedure THTTPDownloadThread.SetOnConnectionFailed(
 139   const Value: TNotifyEvent);
 140 begin
 141   FOnConnectionFailed := Value;
 142 end;
 143
 144 procedure THTTPDownloadThread.SetOnHttpWork(const Value: THttpWorkEvent);
 145 begin
 146   FOnHttpWork := Value;
 147 end;
 148
 149 procedure THTTPDownloadThread.SetOnSuccess(const Value: TNotifyEvent);
 150 begin
 151   FOnSuccess := Value;
 152 end;
 153
 154 procedure THTTPDownloadThread.SetProxyPort(const Value: integer);
 155 begin
 156   if Suspended then
 157     FProxyPort := Value
 158   else
 159     raise EIdException.Create('Tried to change proxy without suspending');
 160 end;
 161
 162 procedure THTTPDownloadThread.SetProxyServer(const Value: String);
 163 begin
 164   if Suspended then
 165     FProxyServer := Value
 166   else
 167     raise EIdException.Create('Tried to change proxy without suspending');
 168 end;
 169
 170 procedure THTTPDownloadThread.SetTriggerWorkEventBy(const Value: integer);
 171 begin
 172   FTriggerWorkEventBy := Value;
 173 end;
 174
 175 procedure THTTPDownloadThread.WorkHandler(Sender: TObject;
 176   AWorkMode: TWorkMode; const AWorkCount: Integer);
 177 begin
 178   if AWorkMode = wmRead then
 179     //Inc(FLoadBytes, AWorkCount);
 180     FLoadBytes := AWorkCount;
 181   if (FLastTriggeredLoadBytes div FTriggerWorkEventBy) <>
 182   (FLoadBytes div FTriggerWorkEventBy) then begin
 183     if Assigned(FOnHttpWork) then Synchronize(DoHttpWork);
 184     FLastTriggeredLoadBytes := FLoadBytes;
 185   end;
 186 end;
 187
 188 end.