Tecsitel_FactuGES2/Source/Base/Conexion/uDataModuleConexion.pas

unit uDataModuleConexion;

interface

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

type
  TdmConexion = class(TDataModule)
    ROMessage: TROBinMessage;
    ROChannel: TROWinInetHTTPChannel;
    procedure DataModuleDestroy(Sender: TObject);
    procedure ROChannel2Failure(Sender: TROTransportChannel;
      anException: Exception; var aRetry: Boolean);
    procedure DataModuleCreate(Sender: TObject);
  private
    FListaConexiones : TStringList;
    function GetChannel: TROTransportChannel;
    function GetMessage: TROBinMessage;
    function GetTargetURL: String;
    procedure SetTargetURL(const Value: String);
    procedure ConfigurarEncriptacionConexion;
    function GetListaConexiones: TStringList;
    procedure SetListaConexiones(const Value: TStringList);
  public
    function HayConexion : Boolean;
    function ProbarConexion(const ATargetURL : String): Boolean;
    procedure ConfigurarConexion;
    procedure EstablecerConexion(aID : integer);
    property TargetURL : String read GetTargetURL write SetTargetURL;
    property Channel: TROTransportChannel read GetChannel;
    property Message: TROBinMessage read GetMessage;
    property ListaConexiones : TStringList read GetListaConexiones write SetListaConexiones;
  end;

var
  dmConexion: TdmConexion;

implementation

{$R *.dfm}

uses
  uROEncryption, Windows, WinInet, cxControls, uConfigurarConexion, Dialogs, Controls,
  uDMBase, FactuGES_Intf, uDialogUtils, uEditorConexiones;

const
  IE_OFFLINE_ERROR = 'Unexpected error in WinInet HTTP Channel (2)';
  SIN_CONEXION_ERROR = 'No se ha podido establecer una conexi<78>n con el servidor';


function TdmConexion.HayConexion: Boolean;
begin
  if not ROChannel.Connected then
  begin
    if ProbarConexion(ROChannel.TargetURL) then
      ROChannel.Connected := True;
  end;
  Result := ROChannel.Connected;
end;

procedure TdmConexion.ConfigurarConexion;
var
  AEditor : TfEditorConexiones;
begin
  AEditor := TfEditorConexiones.Create(NIL);
  try
    AEditor.ListaConexiones := FListaConexiones;
    if AEditor.ShowModal = mrOk then
    begin
      Self.ListaConexiones := AEditor.ListaConexiones;
      dmBase.SalvarConfiguracion;
    end;

  finally
    AEditor.Release;
    AEditor := NIL;
  end;
end;

procedure TdmConexion.ConfigurarEncriptacionConexion;
begin
  {
  with ROChannel.Encryption do
  begin
    EncryptionMethod := tetDES;
    EncryptionSendKey := '127C1A6A4D85F5EFE0A54E104BF7F695CD6C989C1808A57667EF1218E8ED93FC6CDC531631EB9750';
    EncryptionRecvKey := 'C793F1A04FFC8DF91FF9522951F6B6DF921C70B42D74166C6DF0B697797AAA6A243BEC35A9423A51';
    UseCompression := True;
  end;
  }
end;

procedure TdmConexion.DataModuleCreate(Sender: TObject);
begin
  FListaConexiones := TStringList.Create;
  ConfigurarEncriptacionConexion;

  {
    This property specifies can we reuse the same TCP connection to send and
    receive multiple HTTP requests/responses or not. If it set to False then
    each pair request/response creates new one connection.
    Uses KeepConnection = True allows to improve HTTP performance
    for multiple requests.
  }
  ROChannel.KeepConnection := True;
  ROChannel.OnException := ROChannel2Failure;
end;

procedure TdmConexion.DataModuleDestroy(Sender: TObject);
begin
{*  if ROChannel.Connected then
    ROChannel.Connected := False;*}
  FreeAndNil(FListaConexiones);
end;

procedure TdmConexion.EstablecerConexion(aID: integer);
begin
  Self.TargetURL := FListaConexiones[aID];
end;

function TdmConexion.GetChannel: TROTransportChannel;
begin
  Result := ROChannel;
end;

function TdmConexion.GetListaConexiones: TStringList;
begin
  Result := FListaConexiones;
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
    AROBinMessage.Assign(ROMessage);

    AHTTPChannel.Assign(ROChannel);
    AHTTPChannel.OnException := NIL;
    
    with AHTTPChannel do
    begin
      Name := 'HTTPChannel';

      if Length(ATargetURL) > 0 then
        TargetURL := ATargetURL
      else
        TargetURL := ROChannel.TargetURL;
    end;

{    if AHTTPChannel.Encryption.EncryptionMethod <> tetNone then
      ShowMessage('funcionando');}

    ACoService.ServiceName := 'srvLogin';
    ACoService.Message := AROBinMessage;
    ACoService.Channel := AHTTPChannel;

    try
      (ACoService as IsrvLogin).Ping;
      Result := True;
    except
      Result := False;
    end;
  finally
    FreeAndNil(AHTTPChannel);
    FreeAndNil(ACoService);
    FreeAndNil(AROBinMessage);
    HideHourglassCursor;
  end;
end;

procedure TdmConexion.ROChannel2Failure(Sender: TROTransportChannel;
  anException: Exception; var aRetry: Boolean);
var
  AResult : TModalResult;
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
      aRetry := True  // Si el usuario pulsa en 'Conectar' reintentar la operaci<63>n
    else begin
      aRetry := False;
      ROChannel.Connected := False;
      Abort; // Si el usuario pulsa en 'Seguir desconectado' parar todo
    end;
  end;

  if (Pos(anException.Message, SIN_CONEXION_ERROR) > 0) then
  begin
    AResult := ShowErrorMessage('No se ha podido establecer una conexi<78>n con el servidor',
      'No se puede continuar porque no se puede establecer una conexi<78>n con el servidor.' + #10#13 +
      'Puede reintentar establecer la conexi<78>n o anular la operaci<63>n.',
      anException, [TDlgButton_REINTENTAR, TDlgButton_ABORTAR]);
    case AResult of
      mrRetry : aRetry := True;
      mrAbort : begin
                  aRetry := False;
                  ROChannel.Connected := False;
                  Abort;
                end;
    end;
  end;
end;

procedure TdmConexion.SetListaConexiones(const Value: TStringList);
begin
  FListaConexiones.Clear;
  FListaConexiones.AddStrings(Value);
end;

procedure TdmConexion.SetTargetURL(const Value: String);
begin
  ROChannel.TargetURL := Value;
end;

end.