unit uDataModuleServer;

interface

uses
  SysUtils, Classes, uDAEngine, uDAIBXDriver, uDAClasses, uDADriverManager,
  uROClient, uROBinMessage, uROServer, uROIndyTCPServer, uROIndyHTTPServer,
  uROSessions, uDADataTable, uDABINAdapter, IBSQLMonitor, JvComponent,
  JvAppStorage, JvAppRegistryStorage, uDAInterfaces, 
  JvComponentBase, uDAADODriver, uROEventRepository, uDAServerLog,
  JvLogFile, SyncObjs, uDASQLiteDriver, uDABDEDriver, uDADBXDriver,
  uDASDACDriver;

const
  SERVER_PORT = '8099';

type
  TdmServer = class(TDataModule)
    HTTPServer: TROIndyHTTPServer;
    BINMessage: TROBinMessage;
    DriverManager: TDADriverManager;
    DADiagrams: TDADiagrams;
    JvAppRegistryStorage: TJvAppRegistryStorage;
    DAADODriver: TDAADODriver;
    SessionManager: TROInMemorySessionManager;
    ConnectionManager: TDAConnectionManager;
    DAServerLog1: TDAServerLog;
    JvLogFile1: TJvLogFile;
    DASDACDriver: TDASDACDriver;
    DataDictionary: TDADataDictionary;
    procedure DataModuleCreate(Sender: TObject);
    procedure DataModuleDestroy(Sender: TObject);
    procedure HTTPServerBeforeServerActivate(Sender: TObject);
    procedure DAServerLog1AddSQLCommandLog(Sender: TDAServerLog;
      SQLCommandLog: TDASQLCommandLog);
    procedure DAServerLog1AddSQLErrorLog(Sender: TDAServerLog;
      SQLErrorLog: TDASQLErrorLog);
    procedure DriverManagerTraceEvent(Sender: TObject; const Text: string;
      Tag: Integer);
  private
    FConnectionName : string;
    FEscribirLog : TCriticalSection;
    function GetConnectionString: string;
    procedure FindFiles(StartDir: string; var FilesList: TStringList);
    procedure IniciarLog;
    procedure DetenerLog;

  public
    FDBServer : string;
    FDBName : string;
    FDBUser : string;
    FDBPass : string;
    FInicioWindows : Boolean;
    FServerPort : string;
    FDirEntrada : String;
    FDirAlmacen : String;
    FDias : Integer;
    procedure LeerConfiguracion;
    procedure SalvarConfiguracion;
    procedure RefrescarConexion;
    procedure BorrarFicherosDeCargaAntiguos;
    procedure EscribirLog(const AMensaje : String);    
    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;
function GetTempDirectory(ABasePath : string) : string ;


var
  dmServer: TdmServer;

implementation

{$R *.dfm}

uses
  DateUtils, JclFileUtils, ActiveX, Forms, fServerForm, Registry, Windows, Dialogs,
  ADODB;


function GetTempDirectory(ABasePath : string) : string ;
var
   fTime : TDateTime;
   sFile : String;
Begin
   Result := '' ;

   fTime := Frac(Now) ;
   sFile := 'TMP' + Copy(FormatFloat('#.########', fTime), 5, 5);

   while FileExists(ABasePath + PathDelim + sFile) do
   begin
      fTime := Frac(Now);
      sFile := 'TMP'+Copy(FormatFloat('#.########', fTime), 5, 5);
   end;
   Result := sFile ;
end;

Function AddBS(s:String): String;
Begin
   If Copy(s,Length(s),1)<>'\' Then
      s := s + '\' ;
   Result := s ;
End;

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.DAServerLog1AddSQLCommandLog(Sender: TDAServerLog;
  SQLCommandLog: TDASQLCommandLog);
begin
  EscribirLog(SQLCommandLog.OriginalSQLText);
  EscribirLog(SQLCommandLog.OriginalSQLText);
  EscribirLog('-----------------------------------------------------');
end;

procedure TdmServer.DAServerLog1AddSQLErrorLog(Sender: TDAServerLog;
  SQLErrorLog: TDASQLErrorLog);
begin
  EscribirLog(SQLErrorLog.ErrorMessage);
  EscribirLog(SQLErrorLog.OriginalSQLText);
  EscribirLog(SQLErrorLog.OriginalSQLText);
  EscribirLog('-----------------------------------------------------');
end;

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

function TdmServer.GetConnectionString: string;
begin
{  Result := 'SDAC?Server=' + FDBServer
    + ';Database=' + FDBName
    + ';UserID=' + FDBUser
    + ';Password=' + Decrypt(FDBPass);}

  Result := 'ADO?AuxDriver=SQLOLEDB.1;Server=' + FDBServer
    + ';Database=' + FDBName
    + ';UserID=' + FDBUser
    + ';Password=' + Decrypt(FDBPass);
end;

procedure TdmServer.LeerConfiguracion;
begin
  with JvAppRegistryStorage do
  begin
    FDBServer := ReadString('ServerDB');
    FDBName := ReadString('DBName');
    FDBUser := ReadString('UserDB');
    FDBPass := ReadString('PassDB');

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

    FDirEntrada := ReadString('DirEntradaEDI');
    FDirAlmacen := ReadString('DirAlmacenEDI');
    FDias := ReadInteger('DiasAlmacenEDI', 1);
  end;
end;

procedure TdmServer.SalvarConfiguracion;
begin
  with JvAppRegistryStorage do
  begin
    BeginUpdate;
    try
      WriteString('ServerDB', FDBServer);
      WriteString('DBName', FDBName);
      WriteString('UserDB', FDBUser);
      WriteString('PassDB', FDBPass);
      WriteString('ServerPort', FServerPort);

      WriteString('DirEntradaEDI', FDirEntrada);
      WriteString('DirAlmacenEDI', FDirAlmacen);
      WriteInteger('DiasAlmacenEDI', FDias);

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

procedure TdmServer.DataModuleDestroy(Sender: TObject);
begin
  SessionManager.ClearSessions(False);
  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.Acquire;
  try
    JvLogFile1.Add(AMensaje);
  finally
    FEscribirLog.Release;
  end;
end;

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

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

  HTTPServer.Active := TRUE;
end;

procedure TdmServer.HTTPServerBeforeServerActivate(Sender: TObject);
begin
  HTTPServer.Port := StrToInt(FServerPort);
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.BorrarFicherosDeCargaAntiguos;
var
  AAlmacen : String;
  ADate : TDateTime;
  FilesList: TStringList;
  i: integer;
begin
  ADate := Now;
  IncDay(ADate,((-1)*FDias)); //Establecemos fecha desde la que eliminaremos

  AAlmacen := PathAddSeparator(FDirAlmacen);
  FilesList := TStringList.Create;
  try
    FindFiles(AAlmacen, FilesList);
    for i:=0 to FilesList.Count-1 do
    begin
//    showmessage(FilesList.Strings[i]);
      DeleteDirectory(FilesList.Strings[i], false)
    end;
  finally
    FreeAndNil(FilesList);
  end
end;

procedure TdmServer.FindFiles(StartDir: string; var FilesList: TStringList);
const
  MASK_ALL_FILES = '*.*';
  CHAR_POINT = '.';
var
  SR: TSearchRec;
  IsFound: Boolean;
  ADateTime: TDateTime;
begin
  StartDir := PathAddSeparator(StartDir);

  IsFound := (FindFirst(StartDir + MASK_ALL_FILES, faAnyFile, SR) = 0);
  while IsFound do
  begin
    if (SR.Name[1] <> CHAR_POINT) then
    begin
       ADateTime := FileDateToDateTime(SR.Time);
       if (DaysBetween(ADateTime, Now) > FDias) then
          FilesList.Add(StartDir + SR.Name);
    end;
    IsFound := (FindNext(SR) = 0);
  end;
  SysUtils.FindClose(SR);
end;

end.