AbetoDesign_FactuGES2/Source/Base/Conexion/uDataModuleConexion.pas

unit uDataModuleConexion;

interface

uses
  SysUtils, Classes, uRORemoteService, uDADataTable,
  uDABINAdapter, uROClient, uROBinMessage, uROWinInetHttpChannel,
  uDADataStreamer;

const
  SERVER_URL = 'http://localhost:8099/bin'; // Direcci<63>n por defecto del servidor
  
type
  TdmConexion = class(TDataModule)
    ROChannel: TROWinInetHTTPChannel;
    ROMessage: TROBinMessage;
    procedure ROChannelFailure(Sender: TROTransportChannel;
      anException: Exception; var Retry: Boolean);
    procedure DataModuleDestroy(Sender: TObject);
  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,
  uDMBase, 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;

procedure TdmConexion.DataModuleDestroy(Sender: TObject);
begin
  ROChannel.Connected := False;
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<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.