Changeset 91 for branches/DirectWeb/UWebServer.pas

Timestamp:

Dec 21, 2009, 1:19:39 PM (14 years ago)

Author:

george

Message:

• Upraveno: Třída TWebServer oddělena do samostatné jednotky.

File:

• branches/DirectWeb/UWebServer.pas (modified) (3 diffs)

branches/DirectWeb/UWebServer.pas

@@ -18 +18 @@
 type
 
-  { TDatabasePool }
 
-  TDatabasePool = class(TThreadedPool)
-  private
-    FActive: Boolean;
-    procedure SetActive(const AValue: Boolean);
-  public
-    property Active: Boolean read FActive write SetActive;
-  public
-    HostName: string;
-    Schema: string;
-    UserName: string;
-    Password: string;
-    constructor Create;
-    destructor Destroy; override;
-  end;
 
   { TWebServer }
@@ -39 +24 @@
   TWebServer = class
   private
-    SessionStorage: TFileHTTPSessionStorage;
-    procedure ServerInfo(HandlerData: THTTPHandlerData);
   public
     HTTPServer: THTTPServer;
-    DatabasePool: TDatabasePool;
-
-    procedure ViewList(HandlerData: THTTPHandlerData);
-    procedure ViewItem(HandlerData: THTTPHandlerData);
-    procedure SendIndex(HandlerData: THTTPHandlerData);
-    procedure WriteHeader(Stream: TMemoryStreamEx);
-    procedure WriteFooter(Stream: TMemoryStreamEx);
     constructor Create;
     destructor Destroy; override;
-    procedure LoadConfiguration;
-    procedure Run;
   end;
 
 implementation
 
-procedure TWebServer.LoadConfiguration;
-var
-  Config: TXMLDocument;
-  I1: Integer;
-  I2: Integer;
-  I3: Integer;
-begin
-  if FileExists(ConfigFileName) then begin
-    ReadXMLFile(Config, ConfigFileName);
-    for I1 := 0 to Config.ChildNodes.Count - 1 do 
-    with Config.ChildNodes[I1] do begin
-      if NodeName = 'configuration' then
-      for I2 := 0 to ChildNodes.Count - 1 do 
-      with ChildNodes[I2] do begin
-        if NodeName = 'database' then
-        for I3 := 0 to ChildNodes.Count - 1 do 
-        with ChildNodes[I3] do begin
-          if NodeName = 'hostname' then
-            DatabasePool.HostName := TextContent;
-          if NodeName = 'schema' then
-            DatabasePool.Schema := TextContent;
-          if NodeName = 'username' then
-            DatabasePool.UserName := TextContent;
-          if NodeName = 'password' then
-            DatabasePool.Password := TextContent;
-        end;
-        if NodeName = 'server' then
-        for I3 := 0 to ChildNodes.Count - 1 do 
-        with ChildNodes[I3] do begin
-          if NodeName = 'address' then
-            HTTPServer.Socket.Address := TextContent;
-          if NodeName = 'port' then
-            HTTPServer.Socket.Port := StrToInt(TextContent);
-        end;
-      end;
-    end;
-    Config.Destroy;
-  end;
-end;
-
-procedure TWebServer.Run;
-var
-  Command: string;
-begin
-  LoadConfiguration;
-  DatabasePool.Active := True;
-  WriteLn('WoW hosting web server');
-  with HTTPServer do begin
-    Socket.Active := True;
-    WriteLn('Accepting connections.');
-    repeat
-      Write('Server command: ');
-      ReadLn(Command);
-    until Command = 'quit';
-    //WaitForFinish;
-  end;
-end;
-
-procedure TWebServer.ViewList(HandlerData: THTTPHandlerData);
-var
-  SqlDatabase: TSqlDatabase;
-  DbRows: TDbRows;
-  I, II: integer;
-  OrderColumn: string;
-  OrderDirection: string;
-  Title: string;
-  LinkQuery: TQueryParameterList;
-  PageList: TPageList;
-begin
-  SqlDatabase := TSqlDatabase(DatabasePool.Acquire);
-  with HandlerData, Response, Stream, SqlDatabase do
-  begin
-    WriteHeader(Stream);
-
-    WriteString('<div align="center">');
-
-    // Prepare table paging
-    DbRows := Query('SELECT COUNT(*) FROM ' + Request.Query.Values['Table']);
-    PageList := TPageList.Create;
-    PageList.HandlerData := HandlerData;
-    with PageList do begin
-      TotalCount := StrToInt(DbRows[0].ValuesAtIndex[0]);
-      ItemPerPage := 20;
-      NavigatorVisibleItems := 5;
-      Process;
-    end;
-    DbRows.Destroy;
-
-    //WriteString(Request.Query.Values['Table']);
-    OrderColumn    := Request.Query.Values['OrderCol'];
-    OrderDirection := Request.Query.Values['OrderDir'];
-    if OrderDirection = '1' then
-      OrderDirection := 'ASC'
-    else
-      OrderDirection := 'DESC';
-    DbRows := Query('SELECT * FROM ' + Request.Query.Values['Table'] +
-      ' ORDER BY ' + OrderColumn + ' ' + OrderDirection + PageList.SQLLimit);
-
-    LinkQuery := TQueryParameterList.Create;
-    LinkQuery.Assign(Request.Query);
-
-    WriteString('<strong>Seznam typů karet</strong><br/>');
-    WriteString(PageList.Output);
-    WriteString('<table><tr>');
-    if DbRows.Count > 0 then
-      for I := 0 to DbRows[0].Count - 1 do
-      begin
-        Title := DbRows[0].Names[I];
-        LinkQuery.Values['OrderCol'] := Title;
-        if Title = OrderColumn then
-          LinkQuery.Values['OrderDir'] :=
-            IntToStr(1 - StrToInt(Request.Query.Values['OrderDir']))
-        else
-          LinkQuery.Values['OrderDir'] := Request.Query.Values['OrderDir'];
-        Title := '<a href="?' + LinkQuery.Syntetize + '">' + Title + '</a>';
-
-        WriteString('<th>' + Title + '</th>');
-      end;
-    WriteString('</tr>');
-
-    LinkQuery.Destroy;
-    for II := 0 to DbRows.Count - 1 do
-    begin
-      WriteString('<tr>');
-      for I := 0 to DbRows[II].Count - 1 do
-        WriteString('<td>' + DbRows[II].ValuesAtIndex[I] + '</td>');
-      WriteString('</tr>');
-    end;
-    WriteString('</table>');
-    WriteString(PageList.Output);
-    WriteString('</div>');
-
-    DbRows.Destroy;
-    WriteFooter(Stream);
-  end;
-  PageList.Destroy;
-  DatabasePool.Release(SqlDatabase);
-end;
-
-procedure TWebServer.ViewItem(HandlerData: THTTPHandlerData);
-var
-  SqlDatabase: TSqlDatabase;
-  DbRows: TDbRows;
-  I, II: Integer;
-  OrderColumn: string;
-  OrderDirection: string;
-  Title: string;
-  LinkQuery: TQueryParameterList;
-begin
-  SqlDatabase := TSqlDatabase(DatabasePool.Acquire);
-  with HandlerData, Response, Stream, SqlDatabase do
-  begin
-    WriteHeader(Stream);
-    DbRows := Query('SELECT * FROM ' + Request.Query.Values['Table'] +
-      ' WHERE Id=' + Request.Query.Values['Id']);
-    if DbRows.Count > 0 then begin
-      WriteString('<strong>Zobrazení položky</strong>');
-      WriteString('<table><tr><th>Vlastnost</th><th>Hodnota</th></tr>');
-      for I := 0 to DbRows[0].Count - 1 do begin
-        WriteString('<tr><td>' + DbRows[0].Names[I] + '</td><td>' +
-          DbRows[0].ValuesAtIndex[I] + '</td></tr>');
-      end;
-    end else WriteString('Položka nenalezena.');
-    WriteString('</table>');
-    DbRows.Destroy;
-    WriteFooter(Stream);
-  end;
-  DatabasePool.Release(SqlDatabase);
-end;
-
-procedure TWebServer.ServerInfo(HandlerData: THTTPHandlerData);
-var
-  I: Integer;
-begin
-  with HandlerData, Response.Stream do begin
-    //Response.Cookies.Values['Test'] := 'Halo';
-    //Response.Cookies.Values['Test2'] := 'Halo2';
-
-    //HTTPServer.SessionHandler.Variables.Values['Session1'] := 'Value1';
-    //HTTPServer.SessionHandler.Variables.Values['Session2'] := 'Value2';
-
-    WriteString('<a href="?ServerInfo">Refresh</a>');
-
-    WriteString('<h5>Request HTTP headers</h5>');
-    for I := 0 to Request.Headers.Count - 1 do begin;
-      WriteString(Request.Headers.Strings[I] + '<br/>');
-    end;
-
-    WriteString('<h5>Request HTTP cookies</h5>');
-    for I := 0 to Request.Cookies.Count - 1 do begin;
-      WriteString(Request.Cookies.Strings[I] + '<br/>');
-    end;
-
-    WriteString('<h5>Session variables</h5>');
-    for I := 0 to Session.Count - 1 do begin;
-      WriteString(Session.Strings[I] + '<br/>');
-    end;
-
-    WriteString('<h5>Response HTTP headers</h5>');
-    with Response.Stream do
-    for I := 0 to Response.Headers.Count - 1 do begin;
-      WriteString(Response.Headers.Strings[I] + '<br/>');
-    end;
-  end;
-end;
-
-procedure TWebServer.SendIndex(HandlerData: THTTPHandlerData);
-begin
-  with HandlerData, Response, Stream do
-  begin
-    WriteHeader(Stream);
-    WriteString('Index');
-    WriteFooter(Stream);
-  end;
-end;
-
-procedure TWebServer.WriteHeader(Stream: TMemoryStreamEx);
-begin
-  with Stream do
-  begin
-    WriteString('<?xml version="1.0" encoding="UTF-8"?>');
-    WriteString('<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN" "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">');
-    WriteString('<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="cs">');
-    WriteString('<head>');
-    WriteString('<title>');
-    WriteString('Dispečink výtahů');
-    WriteString('</title>');
-    WriteString('<meta http-equiv="content-type" content="application/xhtml+xml; charset=utf-8"/>');
-    WriteString('<link rel="stylesheet" href="Style.css" type="text/css" media="all"/>');
-    WriteString('<script type="text/javascript" src="Application/Style/Custom/Global.js">');
-    WriteString('</script>');
-    WriteString('<script type="text/javascript" src="Base/Style/jquery.js">');
-    WriteString('</script>');
-    WriteString('</head>');
-    WriteString('<body>');
-  end;
-end;
-
-procedure TWebServer.WriteFooter(Stream: TMemoryStreamEx);
-begin
-  with Stream do
-  begin
-    WriteString('</body>');
-    WriteString('</html>');
-  end;
-end;
-
 constructor TWebServer.Create;
 begin
   inherited Create;
-  DatabasePool := TDatabasePool.Create;
-  DatabasePool.TotalCount := 20;
-
-  SessionStorage := TFileHTTPSessionStorage.Create;
   HTTPServer := THTTPServer.Create;
   with HTTPServer, Socket do begin
-    SessionStorage := Self.SessionStorage;
-    DocumentRoot := 'Data';
-    with RequestHandlerList do begin
-      Add('/', SendIndex);
-      Add('/index.htm', SendIndex);
-      Add('/index.html', SendIndex);
-      Add('/logo.png', FileResponse);
-      Add('/Style.css', FileResponse);
-      Add('/ViewList', ViewList);
-      Add('/ViewItem', ViewItem);
-      Add('/ServerInfo', ServerInfo);
-    end;
   end;
 end;
@@ -331 +42 @@
 destructor TWebServer.Destroy;
 begin
-  DatabasePool.Destroy;
   HTTPServer.Destroy;
-  SessionStorage.Destroy;
   inherited Destroy;
 end;
 
-{ TDatabasePool }
-
-procedure TDatabasePool.SetActive(const AValue: Boolean);
-var
-  I: Integer;
-begin
-  if not FActive and AValue then begin
-    for I := 0 to TotalCount - 1 do
-    with TThreadedPoolItem(Items[I]) do begin
-      Item := TSqlDatabase.Create;
-      with TSqlDatabase(Item) do begin
-        HostName := Self.HostName;
-        UserName := Self.UserName;
-        Password := Self.Password;
-        Database := Self.Schema;
-        Connect;
-      end;
-    end;
-  end else
-  if FActive and not AValue then begin
-
-  end;
-  FActive := AValue;
-end;
-
-constructor TDatabasePool.Create;
-begin
-  inherited;
-end;
-
-destructor TDatabasePool.Destroy;
-begin
-  inherited Destroy;
-end;
 
 end.