ProGestion/Base/uDataModuleBase.pas

unit uDataModuleBase;

interface

uses
  Controls, PngImageList, JvComponent, JvNavigationPane, TBXSwitcher,
  TBXOffice2003Theme, Classes, ImgList, uROClient, uROBinMessage,
  uROServiceComponent, uRORemoteService, uROWinInetHttpChannel,
  DataAbstract_Intf, uDADataTable, uDABINAdapter, cxintl, cxIntlPrintSys3,
  FactuGES_Intf, JvAppStorage, JvAppRegistryStorage, SysUtils,
  JvComponentBase;

type
  TdmBase = class(TDataModule)
    ROChannel: TROWinInetHTTPChannel;
    SmallImages: TPngImageList;
    StyleManager: TJvNavPaneStyleManager;
    TBXSwitcher: TTBXSwitcher;
    cxIntl: TcxIntl;
    cxIntlPrintSys3: TcxIntlPrintSys3;
    ROMessage: TROBinMessage;
    DABINAdapter: TDABINAdapter;
    JvAppRegistryStorage: TJvAppRegistryStorage;
    RORemoteService: TRORemoteService;
    procedure DAClientDataModuleCreate(Sender: TObject);
    procedure ROChannelFailure(Sender: TROTransportChannel;
      anException: Exception; var Retry: Boolean);
    procedure ROChannelProgress(iSender: TObject; iType: TProgressType;
      iDirection: TProgressDirection; iTransferred, iTotal: Integer);
  private
    FOnThemeChange: TNotifyEvent;
    function GetAdapter: TDABINAdapter;
    function GetChannel: TROWinInetHTTPChannel;
    function GetCodigoEmpresa: Integer;
    function GetUsuario: String;
    function GetFecha: TDate;
    function GetMessage: TROBinMessage;
    procedure InitStyleManager;
    procedure OnTBXThemeChange(Sender: TObject);
    procedure LeerConfiguracion;
    procedure SalvarConfiguracion;
  public
    procedure ConfigurarConexion;
    property Adapter: TDABINAdapter read GetAdapter;
    property Channel: TROWinInetHTTPChannel read GetChannel;
    property CodigoEmpresa: Integer read GetCodigoEmpresa;
    property Usuario: String read GetUsuario;
    property Fecha: TDate read GetFecha;
    property Message: TROBinMessage read GetMessage;
    property OnThemeChange: TNotifyEvent read FOnThemeChange write
            FOnThemeChange;

    function darRutaDocumentosProyectos: String;
    function darRutaDocumentosProyectosNueva: String;
    function darEstructuraDirProyectos: TDAStringArray;
    function darRutaDocumentosNormativas: String;
    function darRutaDocumentosNormativasNueva: String;
    function darEstructuraDirNormativas: TDAStringArray;
    function darVersion: String;    
  end;

var
  dmBase: TdmBase;

implementation

{$R *.DFM}

uses
  Dialogs, InfoProject, TBX, TBXThemes, uConfigurarConexion, WinInet, Forms, Windows;

const
  SERVER_URL = 'http://localhost:8099/bin';
  IE_OFFLINE_ERROR = 'Unexpected error in WinInet HTTP Channel (2)';

{
*********************************** TdmBase ************************************
}
procedure TdmBase.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;
        SalvarConfiguracion;
      end;
    finally
      Free;
    end;
end;

procedure TdmBase.DAClientDataModuleCreate(Sender: TObject);
begin
  TBXSwitcher.OnThemeChange := OnTBXThemeChange;
  TBXSetTheme('Office2003');

  LeerConfiguracion;
end;

function TdmBase.GetAdapter: TDABINAdapter;
begin
  Result := DABinAdapter;
end;

function TdmBase.GetChannel: TROWinInetHTTPChannel;
begin
  Result := ROChannel;
end;

function TdmBase.GetCodigoEmpresa: Integer;
begin
  Result := 1;
end;

function TdmBase.GetMessage: TROBinMessage;
begin
  Result := ROMessage;
end;

procedure TdmBase.InitStyleManager;
begin
  if not USE_THEMES then
  begin
    TBXSwitcher.EnableXPStyles := False;
    StyleManager.Theme := nptStandard;
  end
  else begin
    TBXSwitcher.EnableXPStyles := True;
    with StyleManager do
    begin
      if CurrentTheme is TTBXOffice2003Theme then
      begin
        case GetOffice2003Scheme of
          osBlue      : Theme := nptXPBlue;
          osMetallic  : Theme := nptXPSilver;
          osGreen     : Theme := nptXPOlive;
          else
                        Theme := nptStandard;
        end;
      end;
    end;
  end;
end;


procedure TdmBase.LeerConfiguracion;
begin
  ROChannel.TargetURL := JvAppRegistryStorage.ReadString('ServerURL', SERVER_URL);
end;

procedure TdmBase.OnTBXThemeChange(Sender: TObject);
begin
  InitStyleManager;

  if Assigned(FOnThemeChange) then
    FOnThemeChange(Sender);
end;

procedure TdmBase.SalvarConfiguracion;
begin
  JvAppRegistryStorage.BeginUpdate;
  try
    JvAppRegistryStorage.WriteString('ServerURL', ROChannel.TargetURL);
  finally
    JvAppRegistryStorage.EndUpdate;
  end;
end;

procedure TdmBase.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
  else
    raise Exception.Create(anException.Message);
end;

procedure TdmBase.ROChannelProgress(iSender: TObject; iType: TProgressType;
  iDirection: TProgressDirection; iTransferred, iTotal: Integer);
begin
{  if iType = ptInProgress then
  begin
    if not Form1.Visible then
      Form1.Show;
  end
  else
    Form1.Hide;}
end;

function TdmBase.GetUsuario: String;
begin
  Result := 'USUARIO';
end;

function TdmBase.GetFecha: TDate;
begin
  Result := Date;
end;

function TdmBase.darRutaDocumentosProyectos: String;
begin
  Result := (RORemoteService as IsrvConfiguracion).darRutaProyectos;
end;

function TdmBase.darRutaDocumentosNormativas: String;
begin
  Result := (RORemoteService as IsrvConfiguracion).darRutaNormativas;
end;

function TdmBase.darEstructuraDirProyectos: TDAStringArray;
begin
  Result := (RORemoteService as IsrvConfiguracion).darEstructuraDirProyectos;
end;

function TdmBase.darEstructuraDirNormativas: TDAStringArray;
begin
  Result := (RORemoteService as IsrvConfiguracion).darEstructuraDirNormativas;
end;

function TdmBase.darVersion: String;
var
  InfoProject : TInfoProject;
begin
  InfoProject := TInfoProject.Create(Self);
  Result := 'v' + InfoProject.FileVersion;
  FreeAndNil(InfoProject);
end;

function TdmBase.darRutaDocumentosNormativasNueva: String;
begin
  Result := (RORemoteService as IsrvConfiguracion).darRutaNormativasNueva;
end;

function TdmBase.darRutaDocumentosProyectosNueva: String;
begin
  Result := (RORemoteService as IsrvConfiguracion).darRutaProyectosNueva;
end;

initialization
  dmBase := TdmBase.Create(NIL);

finalization
  dmBase.Free;

end.