source: trunk/Core.pas

unit Core;

interface

uses
  Classes, SysUtils, FileUtil, LResources, HTTPServerCGI, HTTPSessionMySQL,
  HTTPServer, SqlDatabase, INIFiles, DateUtils, WebPage, WebApp,
  XmlClasses, HtmlClasses, Utils, ApplicationInfo, HTTPServerTCP,
  HTTPSessionFile, User, Registry, ModularSystem, WebSession, LazUTF8;

const
  ConfigFile = 'Config.ini';
  SystemVersionTable = 'SystemVersion';

type

  { TCore }

  TCore = class(TDataModule)
    ApplicationInfo1: TApplicationInfo;
    WebApp1: TWebApp;
    procedure WebApp1PageProduce(HandlerData: THTTPHandlerData);
  private
    procedure Show(Content: string);
  public
    CommonDatabase: TSqlDatabase;
    Load: string;
    Unload: string;
    ShowRuntimeInfo: Boolean;
    Charset: string;
    Admin: string;
    AdminEmail: string;
    Keywords: string;
    Style: string;
    BaseURL: string;
    FormatHTML: Boolean;
    NetworkAddress: string;
    NetworkPort: Integer;
    MaxConnections: Integer;
    DatabaseHostname: string;
    DatabaseUserName: string;
    DatabasePassword: string;
    DatabaseSchema: string;
    procedure LoadFromRegistry;
    procedure SaveToRegistry;
    procedure Run;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  end;

var
  Core: TCore;


implementation

{ TCore }

constructor TCore.Create(AOwner: TComponent);
begin
  inherited;
  CommonDatabase := TSqlDatabase.Create(nil);

  LoadFromRegistry;
  with WebApp1 do begin
    if ServerType = stTCP then begin
      THTTPServerTCP(HTTPServer).Socket.Address := NetworkAddress;
      THTTPServerTCP(HTTPServer).Socket.Port := NetworkPort;
      THTTPServerTCP(HTTPServer).MaxConnection := MaxConnections;
    end;
  end;
end;

destructor TCore.Destroy;
begin
  //SaveToRegistry;
  FreeAndNil(CommonDatabase);
  inherited;
end;

procedure TCore.Show(Content: string);
begin
  //HtmlDocument.Title := ;
(*  BodyParam := '';
  if Load <> '' then BodyParam := BodyParam + ' onload="' + Load + '"';
  if Unload <> '' then BodyParam := BodyParam + ' onunload="' + Unload + '"';
  Document.Encoding := Charset;
  Document.Formated := FormatHTML;*)


(*
  Title := GlobalTitle;
  if Title <> '' then Title := Title + ' - ' + Title;
  Document.TitleTag.SubElements := Title;
  Title := '<span class="GlobalTitle">' + GlobalTitle + '</span>';
  if Title <> '' then Title := Title + ' - ' + $this.Title;

  Keywords := TXMLTag.Create('meta');
  Keywords.Attributes := array('name' => 'keywords', 'content' => implode(',', $this->Keywords));
  Keywords.ShringEmpty := False;
  Document.HeadTag.SubElements.Add(Keywords);

  Document.BodyTag.SubElements := array('<div class="TitlePanel">' + Title + '</div>',
  TopMenu, PageMenu, Content, Footer);
  Result := Document.GetOutput;        *)
end;

procedure TCore.WebApp1PageProduce(HandlerData: THTTPHandlerData);
var
  NewSession: TWebSession;
begin
  NewSession := TWebSession.Create;
  NewSession.MainModule := Self;
  NewSession.Assign(HandlerData);
  NewSession.TimeStart := Now;
  NewSession.Database.HostName := DatabaseHostName;
  NewSession.Database.Password := DatabasePassword;
  NewSession.Database.Database := DatabaseSchema;
  NewSession.Database.UserName := DatabaseUserName;
  NewSession.InitDatabase;
  NewSession.BaseURL := BaseURL;
  NewSession.Run;
  HandlerData.Assign(NewSession);
end;

procedure TCore.LoadFromRegistry;
const
  SectionGeneral = 'General';
  SectionDatabase = 'Database';
  SectionHTTPServer = 'HTTPServer';
begin
  with TIniFile.Create(ConfigFile) do
  try
    //RootKey := HKEY_CURRENT_USER;
    //OpenKey(ApplicationInfo.RegistryKey, True);
    Style := ReadString(SectionGeneral, 'Style', 'Basic');
    BaseURL := ReadString(SectionGeneral, 'BaseURL', 'http://localhost');
    DatabaseHostname := ReadString(SectionDatabase, 'DatabaseHostName', 'localhost');
    DatabaseSchema := ReadString(SectionDatabase, 'DatabaseDatabase', 'web');
    DatabaseUserName := ReadString(SectionDatabase, 'DatabaseUserName', 'user');
    DatabasePassword := ReadString(SectionDatabase, 'DatabasePassword', 'password');
    FormatHTML := ReadBool(SectionGeneral, 'FormatHTML', False);
    WebApp1.LogException := ReadBool(SectionGeneral, 'LogException', False);
    WebApp1.HTTPServer.ShowExceptions := ReadBool(SectionGeneral, 'ShowException', False);
    NetworkAddress := ReadString(SectionHTTPServer, 'NetworkAddress', 'localhost');
    NetworkPort := ReadInteger(SectionHTTPServer, 'NetworkPort', 80);
    MaxConnections := ReadInteger(SectionHTTPServer, 'MaxConnections', 10);
  finally
    Free;
  end;
end;

procedure TCore.SaveToRegistry;
const
  SectionGeneral = 'General';
  SectionDatabase = 'Database';
  SectionHTTPServer = 'HTTPServer';
begin
  with TIniFile.Create(ConfigFile) do
  try
    //RootKey := HKEY_CURRENT_USER;
    //OpenKey(ApplicationInfo.RegistryKey, True);
    WriteString(SectionGeneral, 'Style', Style);
    WriteString(SectionGeneral, 'BaseURL', BaseURL);
    WriteString(SectionDatabase, 'DatabaseHostName', DatabaseHostname);
    WriteString(SectionDatabase, 'DatabaseDatabase', DatabaseSchema);
    WriteString(SectionDatabase, 'DatabaseUserName', DatabaseUserName);
    WriteString(SectionDatabase, 'DatabasePassword', DatabasePassword);
    WriteBool(SectionGeneral, 'FormatHTML', FormatHTML);
    //WriteBool(SectionGeneral, 'ShowException', not WebApp1.LogException);
    WriteString(SectionHTTPServer, 'NetworkAddress', NetworkAddress);
    WriteInteger(SectionHTTPServer, 'NetworkPort', NetworkPort);
    WriteInteger(SectionHTTPServer, 'MaxConnections', MaxConnections);
  finally
    Free;
  end;
end;

procedure TCore.Run;
begin
  CommonDatabase.UserName := DatabaseUserName;
  CommonDatabase.HostName := DatabaseHostname;
  CommonDatabase.Database := DatabaseSchema;
  CommonDatabase.Password := DatabasePassword;
  CommonDatabase.Connect;

  WebApp1.HTTPServer.DocumentRoot := ExtractFileDir(ParamStrUTF8(0));
  WebApp1.Run;
end;

initialization

{$I Core.lrs}

end.