git-svn-id: https://192.168.0.254/svn/Proyectos.ConstruccionesCNJ_FactuGES/trunk@4 6cb6b671-b4a0-dd4c-8bdc-3006503d97e9
152 lines
3.9 KiB
ObjectPascal
152 lines
3.9 KiB
ObjectPascal
unit uDataModuleConexion;
|
||
|
||
interface
|
||
|
||
uses
|
||
SysUtils, Classes, uROServiceComponent, uRORemoteService, uDADataTable,
|
||
uDABINAdapter, uROClient, uROBinMessage, uROWinInetHttpChannel;
|
||
|
||
const
|
||
SERVER_URL = 'http://localhost:8099/bin';
|
||
|
||
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;
|
||
|
||
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';
|
||
Message := AROBinMessage;
|
||
Channel := AHTTPChannel;
|
||
end;}
|
||
|
||
try
|
||
AHTTPChannel.Connected := True;
|
||
AHTTPChannel.Connected := False;
|
||
//(ACoService as IsrvLogin).Ping;
|
||
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<63>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.
|