文字列比較や文字列コピーを減らしてさらに高速化、一般的なスクリプトで元々の約2.3倍

[winbottle/winbottle.git] / bottleclient / HttpThread.pas

diff --git a/bottleclient/HttpThread.pas b/bottleclient/HttpThread.pas
index b8ce80c..fcc8e80 100755 (executable)
--- a/bottleclient/HttpThread.pas
+++ b/bottleclient/HttpThread.pas
@@ -3,9 +3,11 @@ unit HttpThread;
 interface
 
 uses
-  Classes, IdHttp, IdException, SysUtils, Dialogs;
+  Classes, IdHttp, IdException, SysUtils, Dialogs, IdComponent;
 
 type
+  THttpWorkEvent = procedure(Sender: TObject; LoadBytes: integer) of object;
+
   THTTPDownloadThread = class(TThread)
   private
     { Private \90é\8c¾ }
@@ -15,23 +17,42 @@ type
     FRecvString: String;
     FProxyServer: String;
     FProxyPort: integer;
+    FProxyUser: String;
+    FProxyPass: String;
     FOnSuccess: TNotifyEvent;
     FOnConnectionFailed: TNotifyEvent;
+    FLastErrorMessage: String;
+    FOnHttpWork: THttpWorkEvent;
+    FLoadBytes: integer;
+    FLastTriggeredLoadBytes: integer;
+    FTriggerWorkEventBy: integer;
     procedure SetProxyPort(const Value: integer);
     procedure SetProxyServer(const Value: String);
+    procedure SetProxyUser(const Value: String);
+    procedure SetProxyPass(const Value: String);
     procedure SetOnConnectionFailed(const Value: TNotifyEvent);
     procedure SetOnSuccess(const Value: TNotifyEvent);
+    procedure SetOnHttpWork(const Value: THttpWorkEvent);
+    procedure WorkHandler(Sender: TObject; AWorkMode: TWorkMode;
+      const AWorkCount: Integer);
+    procedure SetTriggerWorkEventBy(const Value: integer);
   protected
     procedure Execute; override;
     procedure DoSuccess;
     procedure DoConnectionFailed;
+    procedure DoHttpWork;
   public
     constructor Create(const Host, URL, Post: String); reintroduce;
     property RecvString: String read FRecvString;
     property ProxyServer: String read FProxyServer write SetProxyServer;
     property ProxyPort: integer read FProxyPort write SetProxyPort;
+    property ProxyUser: String read FProxyUser write SetProxyUser;
+    property ProxyPass: String read FProxyPass write SetProxyPass;
     property OnConnectionFailed: TNotifyEvent read FOnConnectionFailed write SetOnConnectionFailed;
     property OnSuccess: TNotifyEvent read FOnSuccess write SetOnSuccess;
+    property OnHttpWork: THttpWorkEvent read FOnHttpWork write SetOnHttpWork;
+    property LastErrorMessage: String read FLastErrorMessage;
+    property TriggerWorkEventBy: integer read FTriggerWorkEventBy write SetTriggerWorkEventBy;
   end;
 
 implementation
@@ -67,6 +88,7 @@ begin
   FHost := Host;
   FURL := URL;
   FPost := Post;
+  FTriggerWorkEventBy := 1024; // KB\92P\88Ê\82ÅOnHttpWork\83C\83x\83\93\83g\94­\90¶
 end;
 
 procedure THTTPDownloadThread.DoConnectionFailed;
@@ -74,6 +96,11 @@ begin
   FOnConnectionFailed(self);
 end;
 
+procedure THTTPDownloadThread.DoHttpWork;
+begin
+  FOnHttpWork(self, FLoadBytes);
+end;
+
 procedure THTTPDownloadThread.DoSuccess;
 begin
   FOnSuccess(self);
@@ -85,12 +112,24 @@ var Http: TIdHTTP;
 begin
   Http := nil;
   TmpStr := nil;
+  FLoadBytes := 0;
+  FLastTriggeredLoadBytes := 0;
   try
     try
       Http := TIdHTTP.Create(nil);
       Http.Host := FHost;
       Http.ProxyParams.ProxyServer := ProxyServer;
       Http.ProxyParams.ProxyPort := ProxyPort;
+
+      if ProxyUser <> '' then begin
+        if ProxyPass <> '' then begin
+          Http.ProxyParams.BasicAuthentication := true;
+          Http.ProxyParams.ProxyUsername := ProxyUser;
+          Http.ProxyParams.ProxyPassword := ProxyPass;
+        end;
+      end;
+
+      Http.OnWork := WorkHandler;
       if FPost = '' then begin
         FRecvString := Http.Get(FURL);
       end else begin
@@ -100,7 +139,8 @@ begin
       if Assigned(FOnSuccess) then Synchronize(DoSuccess);
     except
       on E:EIdException do begin
-        ShowMessage(E.Message);
+        //ShowMessage(E.Message);
+        FLastErrorMessage := E.Message;
         if Assigned(FOnConnectionFailed) then Synchronize(DoConnectionFailed);
       end;
     end;
@@ -116,6 +156,11 @@ begin
   FOnConnectionFailed := Value;
 end;
 
+procedure THTTPDownloadThread.SetOnHttpWork(const Value: THttpWorkEvent);
+begin
+  FOnHttpWork := Value;
+end;
+
 procedure THTTPDownloadThread.SetOnSuccess(const Value: TNotifyEvent);
 begin
   FOnSuccess := Value;
@@ -123,7 +168,7 @@ end;
 
 procedure THTTPDownloadThread.SetProxyPort(const Value: integer);
 begin
-  if not Suspended then
+  if Suspended then
     FProxyPort := Value
   else
     raise EIdException.Create('Tried to change proxy without suspending');
@@ -131,11 +176,44 @@ end;
 
 procedure THTTPDownloadThread.SetProxyServer(const Value: String);
 begin
-  if not Suspended then
+  if Suspended then
     FProxyServer := Value
   else
     raise EIdException.Create('Tried to change proxy without suspending');
 end;
 
+procedure THTTPDownloadThread.SetProxyUser(const Value: String);
+begin
+  if Suspended then
+    FProxyUser := Value
+  else
+    raise EIdException.Create('Tried to change proxy without suspending');
+end;
+
+procedure THTTPDownloadThread.SetProxyPass(const Value: String);
+begin
+  if Suspended then
+    FProxyPass := Value
+  else
+    raise EIdException.Create('Tried to change proxy without suspending');
+end;
+
+procedure THTTPDownloadThread.SetTriggerWorkEventBy(const Value: integer);
+begin
+  FTriggerWorkEventBy := Value;
+end;
+
+procedure THTTPDownloadThread.WorkHandler(Sender: TObject;
+  AWorkMode: TWorkMode; const AWorkCount: Integer);
+begin
+  if AWorkMode = wmRead then
+    //Inc(FLoadBytes, AWorkCount);
+    FLoadBytes := AWorkCount;
+  if (FLastTriggeredLoadBytes div FTriggerWorkEventBy) <>
+  (FLoadBytes div FTriggerWorkEventBy) then begin
+    if Assigned(FOnHttpWork) then Synchronize(DoHttpWork);
+    FLastTriggeredLoadBytes := FLoadBytes;
+  end;
+end;
+
 end.
- 
\ No newline at end of file