ProGestion/Servidor/uDataModuleServer.pas

unit uDataModuleServer;

interface

uses
  SysUtils, Classes, uDAEngine, uDAIBXDriver, uDAClasses, uDADriverManager,
  uROClient, uROBinMessage, uROServer, uROIndyTCPServer, uROIndyHTTPServer,
  uROSessions, uDADataTable, uDABINAdapter, IBSQLMonitor, JvComponent,
  JvAppStorage, JvAppRegistryStorage, uDAInterfaces, JvComponentBase;

type
  TdmServer = class(TDataModule)
    HTTPServer: TROIndyHTTPServer;
    BINMessage: TROBinMessage;
    IBXDriver: TDAIBXDriver;
    DriverManager: TDADriverManager;
    SessionManager: TROInMemorySessionManager;
    DADiagrams: TDADiagrams;
    JvAppRegistryStorage: TJvAppRegistryStorage;
    ConnectionManager: TDAConnectionManager;
    DataDictionary: TDADataDictionary;
    procedure DataModuleCreate(Sender: TObject);
    procedure HTTPServerBeforeServerActivate(Sender: TObject);
  private
    FConnectionName : string;
    FConnectionString : string;
    function GetConnectionString: string;
    property ConnectionString : string read GetConnectionString;
  public
    FDBServer : string;
    FDBPort : string;
    FDBPath : string;
    FDBUser : string;
    FDBPass : string;
    FInicioWindows : Boolean;
    FServerPort : string;
    function LeerConfiguracion : Boolean;
    procedure SalvarConfiguracion;
    procedure Configurar;
    procedure Restart;
    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
  Forms, fServerForm, Registry, Windows, Dialogs, uConfiguracion;

function DarRutaInformes : String;
begin
  Result := ExtractFilePath(Application.ExeName) + 'Informes' + PathDelim;
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;

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;

procedure TdmServer.Configurar;
var
  AForm : TForm;
begin
  AForm := TfConfiguracion.Create(NIL);
  try
    AForm.ShowModal;
  finally
    AForm.Free;
  end;
end;

procedure TdmServer.DataModuleCreate(Sender: TObject);
begin
  if not LeerConfiguracion then
    Configurar;

  Restart;
end;

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

function TdmServer.LeerConfiguracion : Boolean;
begin
  Result := False;

  with JvAppRegistryStorage do
  begin
    FDBServer := ReadString('ServerDB');
    FDBPort := ReadString('PortDB');
    FDBPath := ReadString('PathDB');
    FDBUser := ReadString('UserDB');
    FDBPass := ReadString('PassDB');

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

  Result := (Length(FDBServer) > 0) and
            (Length(FDBPort) > 0) and
            (Length(FDBPath) > 0) and
            (Length(FDBUser) > 0) and
            (Length(FDBPass) > 0) and
            (Length(FServerPort) > 0);
end;

procedure TdmServer.Restart;
begin
  HTTPServer.Active := False;
  ConnectionManager.Connections.GetDefaultConnection.ConnectionString := '';

  ConnectionName := ConnectionManager.GetDefaultConnectionName;
  ConnectionManager.Connections.GetDefaultConnection.ConnectionString := GetConnectionString;

  HTTPServer.Active := TRUE;
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('ServerPort', FServerPort);

      WriteBoolean('InicioWindows', FInicioWindows);
      if FInicioWindows then
        WriteAutoRun('ProGestion Server', Application.ExeName)
      else
        DeleteAutoRun('ProGestion Server');
    finally
      EndUpdate
    end;
  end;
end;

procedure TdmServer.HTTPServerBeforeServerActivate(Sender: TObject);
begin
  HTTPServer.Port := StrToInt(FServerPort);
end;

end.