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, uDADBXDriver, uROEventRepository, JvLogFile, uRODBSessionManager, uDADBSessionManager, SyncObjs; const SERVER_PORT = '8099'; // Puerto por defecto DBSERVER_PORT = '3050'; // Puerto de la BD por defecto SESION_LOGININFO = 'LoginInfo'; type TdmServer = class(TDataModule) HTTPServer: TROIndyHTTPServer; BINMessage: TROBinMessage; IBXDriver: TDAIBXDriver; DriverManager: TDADriverManager; JvAppRegistryStorage: TJvAppRegistryStorage; JvLogFile1: TJvLogFile; DBSessionManager: TDADBSessionManager; schSesiones: TDASchema; ConnectionManager: TDAConnectionManager; 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 DBSessionManagerSessionCreated(const aSession: TROSession); private fCritical : TCriticalSection; FConnectionName : string; function GetConnectionString: string; public FDBServer : string; FDBPort : string; FDBPath : string; FDBUser : string; FDBPass : string; FInicioWindows : Boolean; FServerPort : string; procedure LeerConfiguracion; procedure SalvarConfiguracion; procedure RefrescarConexion; 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 DateUtils, JclFileUtils, ActiveX, Forms, Registry, Windows, Dialogs, uSesionesUtils, uServerMainForm; 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.DataModuleCreate(Sender: TObject); begin fCritical := TCriticalSection.Create; LeerConfiguracion; RefrescarConexion; JvLogFile1.Clear; 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', ''); 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('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; idx: integer; begin fCritical.Enter; try idx := fServerForm.ListBox.Items.IndexOf(GUIDToString(aSessionID)); if (idx>=0) then fServerForm.ListBox.Items.Delete(idx); finally fCritical.Leave; end; // if (csDestroying in ComponentState) then Exit; // See destructor aSession := DBSessionManager.FindSession(aSessionID); if Assigned(aSession) then SesionesHelper.DeleteSessionObject(aSession, SESION_LOGININFO); end; procedure TdmServer.DataModuleDestroy(Sender: TObject); begin FreeAndNIL(fCritical); // This executes before the SessionDeleted event! DBSessionManager.ClearSessions(False); HTTPServer.Active := False; end; procedure TdmServer.DBSessionManagerSessionCreated(const aSession: TROSession); begin fCritical.Enter; try fServerForm.ListBox.Items.Add(GUIDToString(aSession.SessionID)); finally fCritical.Leave; end; end; procedure TdmServer.DriverManagerTraceEvent(Sender: TObject; const Text: string; Tag: Integer); begin JvLogFile1.Add('', Text + #10#13 + #10#13); end; procedure TdmServer.RefrescarConexion; begin HTTPServer.Active := False; ConnectionManager.Connections.GetDefaultConnection.ConnectionString := ''; ConnectionName := ConnectionManager.GetDefaultConnectionName; ConnectionManager.Connections.GetDefaultConnection.ConnectionString := GetConnectionString; CoInitialize(nil); HTTPServer.Active := TRUE; end; procedure TdmServer.HTTPServerBeforeServerActivate(Sender: TObject); begin HTTPServer.Port := StrToInt(FServerPort); end; end.