unit uDataModuleConexion; interface uses SysUtils, Classes, uROServiceComponent, uRORemoteService, uDADataTable, uDABINAdapter, uROClient, uROBinMessage, uROWinInetHttpChannel, uDADataStreamer; const SERVER_URL = 'http://localhost:8099/bin'; // Dirección por defecto del servidor type TdmConexion = class(TDataModule) ROChannel: TROWinInetHTTPChannel; ROMessage: TROBinMessage; DABINAdapter: TDABINAdapter; RORemoteService: TRORemoteService; procedure ROChannelFailure(Sender: TROTransportChannel; anException: Exception; var Retry: Boolean); private function GetChannel: TROWinInetHTTPChannel; function GetMessage: TROBinMessage; function GetTargetURL: String; procedure SetTargetURL(const Value: String); public function HayConexion : Boolean; function ProbarConexion(const ATargetURL : String): Boolean; procedure ConfigurarConexion; property TargetURL : String read GetTargetURL write SetTargetURL; property Channel: TROWinInetHTTPChannel read GetChannel; property Message: TROBinMessage read GetMessage; end; var dmConexion: TdmConexion; implementation {$R *.dfm} uses Windows, WinInet, cxControls, uConfigurarConexion, Dialogs, Controls, uDataModuleBase, FactuGES_Intf; const IE_OFFLINE_ERROR = 'Unexpected error in WinInet HTTP Channel (2)'; function TdmConexion.HayConexion: Boolean; begin Result := ROChannel.Connected; end; procedure TdmConexion.ConfigurarConexion; begin with TfConfigurarConexion.Create(NIL) do try TargetURL := ROChannel.TargetURL; if ShowModal = mrOk then begin ROChannel.TargetURL := TargetURL; ROChannel.Connected := False; ROChannel.Connected := True; dmBase.SalvarConfiguracion; end; finally Free; end; end; function TdmConexion.GetChannel: TROWinInetHTTPChannel; begin Result := ROChannel; end; function TdmConexion.GetMessage: TROBinMessage; begin Result := ROMessage; end; function TdmConexion.GetTargetURL: String; begin Result := ROChannel.TargetURL; end; function TdmConexion.ProbarConexion(const ATargetURL: String): Boolean; var AHTTPChannel: TROWinInetHTTPChannel; AROBinMessage: TROBinMessage; ACoService: TRORemoteService; begin if ATargetURL = '' then raise Exception.Create('No se ha indicado la URL del servidor (HayConexion)'); AHTTPChannel := TROWinInetHTTPChannel.Create(Self); AROBinMessage := TROBinMessage.Create(Self); ACoService := TRORemoteService.Create(Self); ShowHourglassCursor; try with AHTTPChannel do begin Name := 'HTTPChannel'; if Length(ATargetURL) > 0 then TargetURL := ATargetURL else TargetURL := ROChannel.TargetURL; end; with ACoService do begin ServiceName := 'srvLogin'; ACoService.Message := AROBinMessage; Channel := AHTTPChannel; end; try AHTTPChannel.Connected := True; (ACoService as IsrvLogin).Ping; AHTTPChannel.Connected := False; Result := True; except Result := False; end; finally AHTTPChannel.Connected := False; FreeAndNil(AHTTPChannel); FreeAndNil(ACoService); FreeAndNil(AROBinMessage); HideHourglassCursor; end; end; procedure TdmConexion.ROChannelFailure(Sender: TROTransportChannel; anException: Exception; var Retry: Boolean); begin if (Pos(anException.Message, IE_OFFLINE_ERROR) > 0) then begin // Preguntar al usuario si se quiere conectar if InternetGoOnline(PAnsiChar(ROChannel.TargetURL), GetDesktopWindow(), 0) then Retry := True // Si el usuario pulsa en 'Conectar' reintentar la operación else Abort; // Si el usuario pulsa en 'Seguir desconectado' parar todo end end; procedure TdmConexion.SetTargetURL(const Value: String); begin ROChannel.TargetURL := Value; end; end.