Version1.86→1.00（新規）

[winbottle/winbottle.git] / sakurasuite / IdSLPP20.pas

diff --git a/sakurasuite/IdSLPP20.pas b/sakurasuite/IdSLPP20.pas
index 5bf6198..869a0b6 100644 (file)
--- a/sakurasuite/IdSLPP20.pas
+++ b/sakurasuite/IdSLPP20.pas
@@ -50,6 +50,8 @@ type
     FOnConnect: TNotifyEvent;
     FOnDisconnect: TNotifyEvent;
     FLastReadTime: Int64;
+    FTimeout: Integer;
+    FOnConnectFailed: TNotifyEvent;
     procedure SetDebugMode(const Value: boolean);
     procedure SetLUID(const Value: String);
     procedure SetOnSlppEvent(const Value: TIdSlppEvent);
@@ -58,12 +60,16 @@ type
     procedure SetOnDisconnect(const Value: TNotifyEvent);
     function GetLastReadTimeInterval: integer;
     procedure SetLastReadTime(const Value: Int64);
+    procedure SetOnConnectFailed(const Value: TNotifyEvent);
   public
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
     procedure Connect(const ATimeout: Integer = IdTimeoutDefault); override;
+    procedure ConnectServer(const ATimeout: Integer = IdTimeoutDefault);
     procedure Disconnect; override;
     procedure DoOnSlppEvent;
+    procedure DoOnConnect;
+    procedure DoOnConnectFailed;
     property SLPP20ReadThread: TIdSLPP20ReadThread read FSLPPThread;
     property LastReadTime: Int64 read FLastReadTime write SetLastReadTime;
     property LastReadTimeInterval: integer read GetLastReadTimeInterval;
@@ -73,6 +79,7 @@ type
     property DebugMode: boolean read FDebugMode write SetDebugMode;
     property ProxyMode: boolean read FProxyMode write SetProxyMode;
     property OnConnect: TNotifyEvent read FOnConnect write SetOnConnect;
+    property OnConnectFailed: TNotifyEvent read FOnConnectFailed write SetOnConnectFailed;
     property OnDisconnect: TNotifyEvent read FOnDisconnect write SetOnDisconnect;
     property OnSLPPEvent: TIdSlppEvent read FOnSlppEvent write SetOnSlppEvent;
     {ProxyMode = true\82Ì\82Æ\82«\82Í\81AHost, Port\82É\83v\83\8d\83L\83V\96¼\82ð}
@@ -95,11 +102,12 @@ end;
 procedure TIdSLPP20.Connect(const ATimeout: Integer);
 begin
   inherited Connect(ATimeout);
+end;
+
+procedure TIdSLPP20.ConnectServer;
+begin
   try
-    if Assigned(FOnConnect) then begin
-      OnConnect(self);
-    end;
-    // create the reading thread and assign the current Telnet object to it
+    FTimeout := ATimeout;
     FSLPPThread := TIdSLPP20ReadThread.Create(self);
   except on E: EIdSocketError do
     raise EIdSlppClientConnectError.Create('Connection Failed');
@@ -124,18 +132,32 @@ begin
   if Assigned(FSLPPThread) then begin
     FSLPPThread.Terminate;
     // FSLPPThread.WaitFor;
+    FSLPPThread := nil;
   end;
   if Assigned(FOnDisconnect) then begin
     OnDisconnect(self);
   end;
 end;
 
+procedure TIdSLPP20.DoOnConnect;
+begin
+  if Assigned(FOnConnect) then
+    FOnConnect(self);
+end;
+
+procedure TIdSLPP20.DoOnConnectFailed;
+begin
+  if Assigned(FOnConnectFailed) then
+    FOnConnectFailed(self);
+end;
+
 procedure TIdSLPP20.DoOnSlppEvent;
 begin
   try
     FOnSlppEvent(self, FSLPPThread.FEvent, FSLPPThread.FParam);
   except
-    ShowMessage('Exception occured in OnSlppEvent');
+    on E: Exception do
+      ShowMessage('Exception occured in OnSlppEvent: '#13#10 + E.Message);
   end;
 end;
 
@@ -165,6 +187,11 @@ begin
   FOnConnect := Value;
 end;
 
+procedure TIdSLPP20.SetOnConnectFailed(const Value: TNotifyEvent);
+begin
+  FOnConnectFailed := Value;
+end;
+
 procedure TIdSLPP20.SetOnDisconnect(const Value: TNotifyEvent);
 begin
   FOnDisconnect := Value;
@@ -184,14 +211,25 @@ end;
 
 constructor TIdSLPP20ReadThread.Create(AClient: TIdSLPP20);
 begin
-  inherited Create(false);
+  inherited Create(true);
   FClient := AClient;
   FreeOnTerminate := true;
+  Resume;
 end;
 
 procedure TIdSLPP20ReadThread.Execute;
 var Line: String;
 begin
+  try
+    FClient.Connect(FClient.FTimeout);
+    if Assigned(FClient.OnConnect) then begin
+      Synchronize(FClient.DoOnConnect);
+    end;
+  except
+    Synchronize(FClient.DoOnConnectFailed);
+    Exit;
+  end;
+
   FRecvData := TStringList.Create;
   FReceivedLog := TStringList.Create;
   if FClient.ProxyMode then begin