unit uDataModuleServer;

interface

uses
  SysUtils, Classes, SyncObjs, uDAEngine, uDAIBXDriver, JvLogFile, uROSessions,
  JvComponentBase, JvAppStorage, JvAppRegistryStorage, uDAClasses,
  uDADriverManager, uROClient, uROBinMessage, uROServer, uROIndyTCPServer,
  uROIndyHTTPServer, uDAInterfaces, uDAADODriver;

const
  SERVER_PORT = '8099';    // Puerto por defecto
  DBSERVER_PORT = '3050';  // Puerto de la BD por defecto
  MSSQL_PORT = '1433'; // Puerto de la BD por defecto en SQL Server

  SESION_LOGININFO = 'LoginInfo';

type
  TdmServer = class(TDataModule)
    HTTPServer: TROIndyHTTPServer;
    BINMessage: TROBinMessage;
    DriverManager: TDADriverManager;
    JvAppRegistryStorage: TJvAppRegistryStorage;
    SessionManager: TROInMemorySessionManager;
    JvLogFile1: TJvLogFile;
    DAIBXDriver: TDAIBXDriver;
    ConnectionManager: TDAConnectionManager;
    DAADODriver: TDAADODriver;
    procedure DataModuleCreate(Sender: TObject);
    procedure DataModuleDestroy(Sender: TObject);
    procedure HTTPServerBeforeServerActivate(Sender: TObject);
    procedure DriverManagerTraceEvent(Sender: TObject; const Text: string;
      Tag: Integer);
    procedure SessionManagerSessionDeleted(const aSessionID: TGUID;
      IsExpired: Boolean);
    procedure ConnectionManagerConnectionAcquired(Sender: TDAConnectionManager;
      const Connection: IDAConnection);
  private
    FEscribirLog : TCriticalSection;
    FConnectionName : string;
    //function GetConnectionString: string;
    procedure IniciarLog;
    procedure DetenerLog;
    procedure CrearConexiones;   
  public
    FDBServer : string;
    FDBPort : string;
    FDBPath : string;
    FDBUser : string;
    FDBPass : string;

    FMSSQLServer: string;
    FMSSQLIntSecurity : integer;
    FMSSQLPath : string;
    FMSSQLUser : string;
    FMSSQLPass : string;

    FInicioWindows : Boolean;
    FServerPort : string;
    procedure LeerConfiguracion;
    procedure SalvarConfiguracion;
    procedure RefrescarConexion;
    procedure EscribirLog(const AMensaje : String);
    function DarNuevaConexion : IDaConnection;
    property ConnectionName : string read FConnectionName write FConnectionName;
  end;


function DarRutaInformes : String;
function Encrypt (const Source : string) : String;
function Decrypt (const Source : string) : String;
function GetNextAutoinc(AConnection : IDAConnection; const GeneratorName: string): integer;

var
  dmServer: TdmServer;

implementation

{$R *.dfm}

uses
  uROComboService, uROEncryption, DateUtils, JclFileUtils, ActiveX, Forms, Registry, Windows, Dialogs,
  ExtCtrls, uSesionesUtils, uServerAppUtils;

function DarRutaInformes : String;
begin
  Result := ExtractFilePath(Application.ExeName) + 'Informes' + PathDelim;
end;

function GetNextAutoinc(AConnection : IDAConnection; const GeneratorName: string): integer;
var
  ds: IDADataset;
begin
  ds := AConnection.NewDataset(Format('SELECT Gen_id(%s,1) FROM RDB$Database', [GeneratorName]));
  ds.Open;
  result := ds.Fields[0].Value;
  ds.Close;
end;

procedure WriteAutoRun(Name, Value : String);
var
  reg: TRegistry;
begin
  reg := TRegistry.Create;
  try
    reg.RootKey := HKEY_LOCAL_MACHINE;
    reg.LazyWrite := False;
    reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\Run', False);
    reg.WriteString(Name, Value);
    reg.CloseKey;
  finally
    reg.free;
  end;
end;

procedure DeleteAutoRun(Name : String);
var
  reg: TRegistry;
begin
  reg := TRegistry.Create;
  try
    reg.RootKey := HKEY_LOCAL_MACHINE;
    reg.LazyWrite := False;
    reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\Run', False);
    if reg.ValueExists(Name) then
      reg.DeleteValue(Name);
    reg.CloseKey;
  finally
    reg.free;
  end;
end;


function Encrypt (const Source : string) : String;
var
  i:integer;
begin
  Randseed := 28;
  Result := '';
  for i:=1 to length(Source) do
    Result := Result + chr(ord(Source[i]) + Random(10) + 1);
end;

function Decrypt (const Source : string) : String;
var
  i : integer;
begin
  Randseed:= 28;
  Result := '';
  for i := 1 to length(Source) do
    Result := Result + chr(ord(Source[i]) - Random(10) - 1);
end;

procedure TdmServer.ConnectionManagerConnectionAcquired(
  Sender: TDAConnectionManager; const Connection: IDAConnection);
begin
  { Si se adquiere una conexión del spool de conexiones puede que
    sea una conexión ya abierta. Aquí nos aseguramos de que esté
    cerrada y lista para usar. }
  if Connection.InTransaction then
    Connection.RollbackTransaction;
end;

procedure TdmServer.CrearConexiones;
var
  AConn : String;
begin
  //IBX
  AConn := 'IBX?Server=' + FDBServer + '/' + FDBPort
    + ';Database=' + FDBPath
    + ';UserID=' + FDBUser
    + ';Password=' + Decrypt(FDBPass)
    + ';Dialect=3;Charset=ISO8859_1;';
  ConnectionManager.Connections.ConnectionByName('IBX').ConnectionString := AConn;

  //MSSQL
  //ADO?AuxDriver=SQLOLEDB.1;Server=ROB_VM_FARMACIA\FARMATIC;Database=farmatic;UserID=rodax;Password=rodax;
  //ADO?AuxDriver=SQLOLEDB.1;Server=ROB_VM_FARMACIA\FARMATIC;Database=farmatic;Integrated Security=SSPI

  AConn := 'ADO?AuxDriver=SQLOLEDB.1;Server=' + FMSSQLServer
    + ';Database=' + FMSSQLPath;

  if FMSSQLIntSecurity = 1 then
    AConn := AConn + ';Integrated Security=SSPI'
  else
    AConn := AConn + ';UserID=' + FMSSQLUser
    + ';Password=' + Decrypt(FMSSQLPass);
  ConnectionManager.Connections.ConnectionByName('FARMATIC').ConnectionString := AConn;    
end;

function TdmServer.DarNuevaConexion: IDAConnection;
begin
  with ConnectionManager do
    Result := NewConnection(GetDefaultConnectionName, False);
  if not Result.isAlive then
    Result.Open;
end;

procedure TdmServer.IniciarLog;
begin
  FEscribirLog := TCriticalSection.Create;

  JvLogFile1.Active := False;
  JvLogFile1.FileName := ExtractFilePath(Application.ExeName) + 'ServerLog.txt';
  JvLogFile1.AutoSave := True;
  JvLogFile1.Active := True;
  JvLogFile1.Clear;
end;

procedure TdmServer.DataModuleCreate(Sender: TObject);
begin
  LeerConfiguracion;
  RefrescarConexion;
  IniciarLog;
end;

{function TdmServer.GetConnectionString: string;
begin
  Result := 'IBX?Server=' + FDBServer + '/' + FDBPort
    + ';Database=' + FDBPath
    + ';UserID=' + FDBUser
    + ';Password=' + Decrypt(FDBPass)
    + ';Dialect=3;Charset=ISO8859_1;';

end;}

procedure TdmServer.LeerConfiguracion;
begin
  with JvAppRegistryStorage do
  begin
    FDBServer := ReadString('ServerDB', 'localhost');
    FDBPort := ReadString('PortDB', DBSERVER_PORT);
    FDBPath := ReadString('PathDB');
    FDBUser := ReadString('UserDB', '');
    FDBPass := ReadString('PassDB', '');

    FMSSQLServer := ReadString('ServerMSSQL', '');
    FMSSQLIntSecurity := ReadInteger('IntSecurityMSSQL', 0);
    FMSSQLPath := ReadString('PathMSSQL');
    FMSSQLUser := ReadString('UserMSSQL', '');
    FMSSQLPass := ReadString('PassMSSQL', '');

    FServerPort := ReadString('ServerPort', SERVER_PORT);
    FInicioWindows := ReadBoolean('InicioWindows', False);
  end;
end;

procedure TdmServer.SalvarConfiguracion;
begin
  with JvAppRegistryStorage do
  begin
    BeginUpdate;
    try
      WriteString('ServerDB', FDBServer);
      WriteString('PortDB', FDBPort);
      WriteString('PathDB', FDBPath);
      WriteString('UserDB', FDBUser);
      WriteString('PassDB', FDBPass);

      WriteString('ServerMSSQL', FMSSQLServer);
      WriteInteger('IntSecurityMSSQL', FMSSQLIntSecurity);
      WriteString('PathMSSQL', FMSSQLPath);
      WriteString('UserMSSQL', FMSSQLUser);
      WriteString('PassMSSQL', FMSSQLPass);

      WriteString('ServerPort', FServerPort);
      WriteBoolean('InicioWindows', FInicioWindows);
      if FInicioWindows then
        WriteAutoRun('AdminPV_Server', Application.ExeName)
      else
        DeleteAutoRun('AdminPV_Server');
    finally
      EndUpdate
    end;
  end;
end;

procedure TdmServer.SessionManagerSessionDeleted(const aSessionID: TGUID;
  IsExpired: Boolean);
var
  aSession : TROSession;
begin
  aSession := SessionManager.FindSession(aSessionID);
  if Assigned(aSession) then
    SesionesHelper.DeleteSessionObject(aSession, SESION_LOGININFO);
end;

procedure TdmServer.DataModuleDestroy(Sender: TObject);
begin
  SessionManager.ClearSessions(False);
  ConnectionManager.ClearPool;
  HTTPServer.Active := False;
  DetenerLog;
end;

procedure TdmServer.DetenerLog;
begin
  FEscribirLog.Free;
end;

procedure TdmServer.DriverManagerTraceEvent(Sender: TObject; const Text: string;
  Tag: Integer);
begin
  EscribirLog(Text + #10#13 + #10#13);
end;

procedure TdmServer.EscribirLog(const AMensaje: String);
begin
  FEscribirLog.Enter;
  try
    JvLogFile1.Add(AMensaje);
  finally
    FEscribirLog.Leave;
  end;
end;

procedure TdmServer.RefrescarConexion;
begin
  HTTPServer.Active := False;

  CrearConexiones;

  ConnectionName := ConnectionManager.GetDefaultConnectionName;

  if not ROIsService then
    ShowBalloonHint('Conectado a ' + ConnectionName, bfInfo);

  CoInitialize(nil);
  HTTPServer.Active := TRUE;
end;

procedure TdmServer.HTTPServerBeforeServerActivate(Sender: TObject);
begin
  HTTPServer.Port := StrToInt(FServerPort);
  {
  with HTTPServer.Encryption do
  begin
    EncryptionMethod := tetDES;
    EncryptionSendKey := 'C793F1A04FFC8DF91FF9522951F6B6DF921C70B42D74166C6DF0B697797AAA6A243BEC35A9423A51';
    EncryptionRecvKey := '127C1A6A4D85F5EFE0A54E104BF7F695CD6C989C1808A57667EF1218E8ED93FC6CDC531631EB9750';
    UseCompression := True;
  end;
  }
end;

end.
