Changeset 91


Ignore:
Timestamp:
Sep 7, 2012, 8:36:13 PM (12 years ago)
Author:
chronos
Message:
  • Upraveno: Modulární systém přepracován tak, aby podporoval metody Install, Uninstall a Upgrade použitelné pro persistentní data. Původní metody Install a Uninstall přejmenovýny na Start a Stop.
Location:
trunk
Files:
2 added
2 deleted
5 edited

Legend:

Unmodified
Added
Removed

  • trunk/Modules/User/UModuleUser.pas

    r90 r91  
    1616    constructor Create(Owner: TComponent); override;
    1717    destructor Destroy; override;
     18    procedure Start; override;
     19    procedure Stop; override;
    1820    procedure Install; override;
    1921    procedure Uninstall; override;
    20     procedure Update; override;
     22    procedure Upgrade; override;
    2123  end;
    2224
     25
    2326implementation
     27
     28uses
     29  UCore, UUserControlPage, USqlDatabase;
    2430
    2531{ TModuleUser }
    … …  
    2834begin
    2935  inherited;
     36  Identification := 'User';
     37  Title := 'User management';
     38  Version := '0.1';
     39  License := 'GNU/LGPL v3';
     40  Author := 'Chronosoft';
    3041end;
    3142
    … …  
    3546end;
    3647
    37 procedure TModuleUser.Install;
     48procedure TModuleUser.Start;
    3849begin
     50  Core.Pages.RegisterPage(TUserControlPage, UserControlPage, 'uzivatel');
     51  //RegisterPage(TUserControlPage, UserControlPage, '');
    3952  inherited;
    4053end;
    4154
    42 procedure TModuleUser.Uninstall;
     55procedure TModuleUser.Stop;
    4356begin
    4457  inherited;
     58  Core.Pages.UnregisterPage('uzivatel');
    4559end;
    4660
    47 procedure TModuleUser.Update;
     61procedure TModuleUser.Install;
     62var
     63  DbRows: TDbRows;
     64begin
     65  try
     66    DbRows := TDbRows.Create;
     67    Core.CommonDatabase.Query(DbRows, 'CREATE TABLE IF NOT EXISTS `User` (' +
     68  '`Id` int(11) NOT NULL AUTO_INCREMENT,' +
     69  '`Name` varchar(255) NOT NULL,' +
     70  '`FullName` varchar(255) NOT NULL,' +
     71  '`Password` varchar(255) NOT NULL,' +
     72  '`Salt` varchar(255) NOT NULL,' +
     73  '`Email` varchar(255) NOT NULL,' +
     74  '`RegistrationTime` datetime NOT NULL,' +
     75  'PRIMARY KEY (`Id`)' +
     76  ') ENGINE=InnoDB  DEFAULT CHARSET=utf8 AUTO_INCREMENT=1 ;');
     77    Core.CommonDatabase.Query(DbRows, 'CREATE TABLE IF NOT EXISTS `UserOnline` (' +
     78  '`Id` int(11) NOT NULL AUTO_INCREMENT,' +
     79  '`User` int(11) NOT NULL DEFAULT ''0'',' +
     80  '`ActivityTime` datetime NOT NULL DEFAULT ''0000-00-00 00:00:00'',' +
     81  '`LoginTime` datetime NOT NULL DEFAULT ''0000-00-00 00:00:00'',' +
     82  '`SessionId` varchar(255) COLLATE utf8_czech_ci NOT NULL DEFAULT '''',' +
     83  '`IpAddress` varchar(16) COLLATE utf8_czech_ci NOT NULL DEFAULT '''',' +
     84  '`HostName` varchar(255) COLLATE utf8_czech_ci NOT NULL DEFAULT '''',' +
     85  '`ScriptName` varchar(255) COLLATE utf8_czech_ci NOT NULL,' +
     86  'PRIMARY KEY (`Id`),' +
     87  'KEY `User` (`User`)' +
     88  ') ENGINE=MEMORY  DEFAULT CHARSET=utf8 COLLATE=utf8_czech_ci AUTO_INCREMENT=2 ;');
     89  finally
     90    DbRows.Free;
     91  end;
     92  inherited Install;
     93end;
     94
     95procedure TModuleUser.Uninstall;
     96var
     97  DbRows: TDbRows;
     98begin
     99  inherited Uninstall;
     100  try
     101    DbRows := TDbRows.Create;
     102    Core.CommonDatabase.Query(DbRows, 'DROP TABLE `User`');
     103    Core.CommonDatabase.Query(DbRows, 'DROP TABLE `UserOnline`');
     104  finally
     105    DbRows.Free;
     106  end;
     107end;
     108
     109procedure TModuleUser.Upgrade;
    48110begin
    49111  inherited;

  • trunk/Packages/CoolWeb/WebServer/UWebApp.pas

    r84 r91  
    2323    function FindByName(Name: string): TRegistredPage;
    2424    procedure RegisterPage(PageClass: TWebPageClass; out Reference; Path: string);
     25    procedure UnregisterPage(Path: string);
    2526    function ProducePage(HandlerData: THTTPHandlerData): Boolean;
    2627  end;
    … …  
    119120end;
    120121
     122procedure TPageList.UnregisterPage(Path: string);
     123var
     124  Page: TRegistredPage;
     125begin
     126  Page := FindByName(Path);
     127  Remove(Page);
     128end;
     129
    121130function TPageList.ProducePage(HandlerData: THTTPHandlerData): Boolean;
    122131var

  • trunk/Packages/ModularSystem/UModularSystem.pas

    r89 r91  
    1919  TModule = class(TComponent)
    2020  private
     21    FRunning: Boolean;
    2122    FInstalled: Boolean;
    2223    Manager: TModuleManager;
    … …  
    2930    FDescription: TStringList;
    3031    procedure SetInstalled(AValue: Boolean);
     32    procedure SetRunning(AValue: Boolean);
    3133  public
    3234    API: TAPI;
    3335    MarkForInstall: Boolean;
     36    procedure Start; virtual;
     37    procedure Stop; virtual;
    3438    procedure Install; virtual;
    3539    procedure Uninstall; virtual;
    36     procedure Update; virtual;
     40    procedure Upgrade; virtual;
     41    procedure EnumModulesStart(ModuleList: TStringList);
     42    procedure EnumModulesStop(ModuleList: TStringList);
    3743    procedure EnumModulesInstall(ModuleList: TStringList);
    3844    procedure EnumModulesUninstall(ModuleList: TStringList);
    3945    constructor Create(Owner: TComponent); virtual;
    4046    destructor Destroy; override;
     47    property Running: Boolean read FRunning write SetRunning;
    4148    property Installed: Boolean read FInstalled write SetInstalled;
    4249  published
    … …  
    5966    Modules: TObjectList; // TObjectList<TModule>
    6067    function FindModuleByName(Name: string): TModule;
     68    procedure StartDependencies(ModuleName: string; Dependencies: TStringList);
     69    procedure StopDependencies(ModuleName: string);
     70    procedure EnumModulesStart(Dependencies, ModuleList: TStringList);
     71    procedure EnumModulesStop(ModuleName: string; ModuleList: TStringList);
    6172    procedure InstallDependencies(ModuleName: string; Dependencies: TStringList);
    6273    procedure UninstallDependencies(ModuleName: string);
    … …  
    6576    procedure RegisterModule(Module: TModule; MarkForInstall: Boolean = False);
    6677    procedure UnregisterModule(Module: TModule);
     78    procedure StartInstalled;
    6779    procedure InstallMarked;
     80    procedure StopAll;
    6881    procedure UninstallAll;
    6982    constructor Create(AOwner: TComponent); override;
    … …  
    107120end;
    108121
    109 procedure TModuleManager.InstallDependencies(ModuleName: string; Dependencies: TStringList);
     122procedure TModuleManager.StartDependencies(ModuleName: string; Dependencies: TStringList);
     123var
     124  Module: TModule;
     125  I: Integer;
     126begin
     127  for I := 0 to Dependencies.Count - 1 do begin
     128    Module := FindModuleByName(Dependencies[I]);
     129    if Assigned(Module) then begin
     130      if not Module.Running then Module.Start;
     131    end else raise Exception.CreateFmt(SModuleNotFound, [ModuleName, Dependencies[I]]);
     132  end;
     133end;
     134
     135procedure TModuleManager.StopDependencies(ModuleName: string);
     136var
     137  I: Integer;
     138begin
     139  for I := 0 to Modules.Count - 1 do
     140  with TModule(Modules[I]) do begin
     141    if (Dependencies.IndexOf(ModuleName) <> - 1) and Running then Stop;
     142  end;
     143end;
     144
     145procedure TModuleManager.EnumModulesStart(Dependencies,
     146  ModuleList: TStringList);
     147var
     148  Module: TModule;
     149  I: Integer;
     150begin
     151  for I := 0 to Dependencies.Count - 1 do begin
     152    Module := FindModuleByName(Dependencies[I]);
     153    if Assigned(Module) then begin
     154      if not Module.Running and (ModuleList.IndexOf(Module.Identification) = -1) then begin
     155        ModuleList.Add(Module.Identification);
     156        EnumModulesStart(Module.Dependencies, ModuleList);
     157      end;
     158    end else raise Exception.CreateFmt(SModuleNotFound, [Module.Identification]);
     159  end;
     160end;
     161
     162procedure TModuleManager.EnumModulesStop(ModuleName: string;
     163  ModuleList: TStringList);
     164var
     165  I: Integer;
     166begin
     167  for I := 0 to Modules.Count - 1 do
     168  with TModule(Modules[I]) do begin
     169    if (Dependencies.IndexOf(ModuleName) <> -1) and Running and
     170      (ModuleList.IndexOf(Identification) = -1) then begin
     171      ModuleList.Add(Identification);
     172      Self.EnumModulesStop(Identification, ModuleList);
     173    end;
     174  end;
     175end;
     176
     177procedure TModuleManager.InstallDependencies(ModuleName: string;
     178  Dependencies: TStringList);
    110179var
    111180  Module: TModule;
    … …  
    176245end;
    177246
     247procedure TModuleManager.StartInstalled;
     248var
     249  I: Integer;
     250begin
     251  for I := 0 to Modules.Count - 1 do
     252  with TModule(Modules[I]) do
     253    if not Running and Installed then Start;
     254end;
     255
    178256procedure TModuleManager.InstallMarked;
    179257var
    … …  
    185263end;
    186264
     265procedure TModuleManager.StopAll;
     266var
     267  I: Integer;
     268begin
     269  for I := 0 to Modules.Count - 1 do
     270  with TModule(Modules[I]) do
     271    if Running then Stop;
     272end;
     273
    187274procedure TModuleManager.UninstallAll;
    188275var
    … …  
    202289destructor TModuleManager.Destroy;
    203290begin
    204   UninstallAll;
     291  StopAll;
    205292  FreeAndNil(Modules);
    206293  inherited Destroy;
    … …  
    209296{ TModule }
    210297
     298procedure TModule.SetRunning(AValue: Boolean);
     299begin
     300  if FRunning = AValue then Exit;
     301  if AValue then Start else Stop;
     302end;
     303
    211304procedure TModule.SetInstalled(AValue: Boolean);
    212305begin
    213306  if FInstalled = AValue then Exit;
    214307  if AValue then Install else Uninstall;
     308end;
     309
     310procedure TModule.Start;
     311begin
     312  if Running then Exit;
     313  Manager.StartDependencies(Identification, Dependencies);
     314  FRunning := True;
     315end;
     316
     317procedure TModule.Stop;
     318begin
     319  if not Running then Exit;
     320  Manager.StopDependencies(Identification);
     321  FRunning := False;
    215322end;
    216323
    … …  
    225332begin
    226333  if not Installed then Exit;
     334  if Running then Stop;
    227335  Manager.UninstallDependencies(Identification);
    228336  FInstalled := False;
    229337end;
    230338
    231 procedure TModule.Update;
    232 begin
    233   if not Installed then Exit;
     339procedure TModule.Upgrade;
     340begin
     341  if not Running then Exit;
     342end;
     343
     344procedure TModule.EnumModulesStart(ModuleList: TStringList);
     345begin
     346  ModuleList.Clear;
     347  Manager.EnumModulesStart(Dependencies, ModuleList);
     348end;
     349
     350procedure TModule.EnumModulesStop(ModuleList: TStringList);
     351begin
     352  ModuleList.Clear;
     353  Manager.EnumModulesStop(Identification, ModuleList);
    234354end;
    235355
    … …  
    255375destructor TModule.Destroy;
    256376begin
    257   Installed := False;
     377  Running := False;
    258378  Description.Free;
    259379  Dependencies.Free;

  • trunk/UCore.pas

    r89 r91  
    5151    procedure RegisterModules;
    5252  public
     53    CommonDatabase: TSqlDatabase;
    5354    ModuleManager: TModuleManager;
    5455    Load: string;
    … …  
    110111  SessionStorage.Free;
    111112  Database.Free;
    112   inherited Destroy;
     113  inherited;
    113114end;
    114115
    … …  
    173174  ModuleManager := TModuleManager.Create(nil);
    174175  Pages := TPageList.Create;
    175 
    176   RegisterModules;
    177   ModuleManager.InstallMarked;
     176  CommonDatabase := TSqlDatabase.Create(nil);
    178177
    179178  LoadFromRegistry;
    … …  
    188187    RegisterPage(TServerInfoPage, ServerInfoPage, 'serverinfo');
    189188    RegisterPage(TWebCamPage, WebCamPage, 'kamery');
    190     //RegisterPage(TUserControlPage, UserControlPage, 'uzivatel');
    191189    RegisterPage(TPlansPage, PlansPage, 'plany');
    192190    RegisterPage(TNetworkPage, NetworkPage, 'sit');
    193191    RegisterPage(TProjectsPage, ProjectsPage, 'projekty');
    194192    RegisterPage(TAboutPage, AboutPage, '');
    195     //RegisterPage(TUserControlPage, UserControlPage, '');
    196193  end;
    197194  with WebApp1 do begin
    … …  
    207204begin
    208205  //SaveToRegistry;
    209   Pages.Free;
    210   inherited Destroy;
     206  FreeAndNil(CommonDatabase);
     207  FreeAndNil(ModuleManager);
     208  FreeAndNil(Pages);
     209  inherited;
    211210end;
    212211
    … …  
    419418procedure TCore.Run;
    420419begin
     420  CommonDatabase.UserName := DatabaseUserName;
     421  CommonDatabase.HostName := DatabaseHostname;
     422  CommonDatabase.Database := DatabaseSchema;
     423  CommonDatabase.Password := DatabasePassword;
     424  CommonDatabase.Connect;
     425
     426  RegisterModules;
     427  ModuleManager.StartInstalled;
     428
    421429  WebApp1.HTTPServer.DocumentRoot := ExtractFileDir(ParamStrUTF8(0));
    422430  WebApp1.Run;

  • trunk/ZdechovNET.lpi

    r89 r91  
    164164      </Unit14>
    165165      <Unit15>
    166         <Filename Value="Pages/UUserControlPage.pas"/>
    167         <IsPartOfProject Value="True"/>
    168         <ComponentName Value="UserControlPage"/>
    169         <HasResources Value="True"/>
    170         <ResourceBaseClass Value="DataModule"/>
    171         <UnitName Value="UUserControlPage"/>
     166        <Filename Value="Pages/UNetworkPage.pas"/>
     167        <IsPartOfProject Value="True"/>
     168        <ComponentName Value="NetworkPage"/>
     169        <HasResources Value="True"/>
     170        <ResourceBaseClass Value="DataModule"/>
     171        <UnitName Value="UNetworkPage"/>
    172172      </Unit15>
    173173      <Unit16>
    174         <Filename Value="Pages/UNetworkPage.pas"/>
    175         <IsPartOfProject Value="True"/>
    176         <ComponentName Value="NetworkPage"/>
    177         <HasResources Value="True"/>
    178         <ResourceBaseClass Value="DataModule"/>
    179         <UnitName Value="UNetworkPage"/>
     174        <Filename Value="Pages/UAboutPage.pas"/>
     175        <IsPartOfProject Value="True"/>
     176        <ComponentName Value="AboutPage"/>
     177        <HasResources Value="True"/>
     178        <ResourceBaseClass Value="DataModule"/>
     179        <UnitName Value="UAboutPage"/>
    180180      </Unit16>
    181181      <Unit17>
    182         <Filename Value="Pages/UAboutPage.pas"/>
    183         <IsPartOfProject Value="True"/>
    184         <ComponentName Value="AboutPage"/>
    185         <HasResources Value="True"/>
    186         <ResourceBaseClass Value="DataModule"/>
    187         <UnitName Value="UAboutPage"/>
     182        <Filename Value="ReadMe.txt"/>
     183        <IsPartOfProject Value="True"/>
    188184      </Unit17>
    189185      <Unit18>
    190         <Filename Value="ReadMe.txt"/>
    191         <IsPartOfProject Value="True"/>
     186        <Filename Value="Pages/UProjectsPage.pas"/>
     187        <IsPartOfProject Value="True"/>
     188        <ComponentName Value="ProjectsPage"/>
     189        <HasResources Value="True"/>
     190        <ResourceBaseClass Value="DataModule"/>
     191        <UnitName Value="UProjectsPage"/>
    192192      </Unit18>
    193193      <Unit19>
    194         <Filename Value="Pages/UProjectsPage.pas"/>
    195         <IsPartOfProject Value="True"/>
    196         <ComponentName Value="ProjectsPage"/>
    197         <HasResources Value="True"/>
    198         <ResourceBaseClass Value="DataModule"/>
    199         <UnitName Value="UProjectsPage"/>
     194        <Filename Value="Modules/User/UModuleUser.pas"/>
     195        <IsPartOfProject Value="True"/>
     196        <UnitName Value="UModuleUser"/>
    200197      </Unit19>
    201198      <Unit20>
    202         <Filename Value="Modules/User/UModuleUser.pas"/>
    203         <IsPartOfProject Value="True"/>
    204         <UnitName Value="UModuleUser"/>
     199        <Filename Value="UCore.pas"/>
     200        <IsPartOfProject Value="True"/>
     201        <ComponentName Value="Core"/>
     202        <HasResources Value="True"/>
     203        <ResourceBaseClass Value="DataModule"/>
     204        <UnitName Value="UCore"/>
    205205      </Unit20>
    206206      <Unit21>
    207         <Filename Value="UCore.pas"/>
    208         <IsPartOfProject Value="True"/>
    209         <ComponentName Value="Core"/>
    210         <HasResources Value="True"/>
    211         <ResourceBaseClass Value="DataModule"/>
    212         <UnitName Value="UCore"/>
     207        <Filename Value="Modules/User/UUserControlPage.pas"/>
     208        <IsPartOfProject Value="True"/>
     209        <ComponentName Value="UserControlPage"/>
     210        <HasResources Value="True"/>
     211        <ResourceBaseClass Value="DataModule"/>
     212        <UnitName Value="UUserControlPage"/>
    213213      </Unit21>
    214214    </Units>
Note: See TracChangeset for help on using the changeset viewer.