source: branches/web2/UMainForm.pas

program UMainForm;

{$mode delphi}

uses
  {$IFDEF UNIX}{$IFDEF UseCThreads}
  cthreads,
  {$ENDIF}{$ENDIF}
  SysUtils, Classes, UHtmlClasses, UXmlClasses, IdContext, IdSocketHandle, 
  IdBaseComponent, IdComponent, IdTCPServer, IdCustomHTTPServer, IdHTTPServer, 
  USqlDatabase, DateUtils;

type
  TUser = class
  public
    Database: TSqlDatabase;
    SessionId: string;
    Name: string;
    Password: string;
    Email: string;
    FullName: string;
    LastLogin: TDateTime;
    function Login(UserName, Password: string): Boolean;
  end;

  TUserOnline = class
  public
    User: TUser;
    IpAddress: string;
    Time: TDateTime;
    SessionId: string;
  end;

  TMainForm = class
    IdHTTPServer1: TIdHTTPServer;
    constructor Create;
    procedure IdHTTPServer1CommandGet(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
    procedure IdHTTPServer1SessionStart(Sender: TIdHTTPSession);
    procedure IdHTTPServer1SessionEnd(Sender: TIdHTTPSession);
    destructor Destroy; override;
  private
    { Private declarations }
  public
    Database: TSqlDatabase;
    UserSessions: TList; // of TUser;
    HtmlPage: THtmlPage;
    Page: THtmlPage;
  end;

var
  MainForm: TMainForm;

constructor TMainForm.Create;
var
  SocketHandle : TIdSocketHandle;
begin
  Database := TSqlDatabase.Create;
  with Database do begin
    Hostname := 'localhost';
    UserName := 'root';
    Password := '';
    Database := 'wow';
    Connect;
  end;
  UserSessions := TList.Create;

  (*
  HtmlPage := THtmlPage.Create;
  with HtmlPage do begin
    Title := 'Centrála - Rozcestník';
    Charset := 'windows-1250';
    with Body, THtmlLink(SubItems[SubItems.Add(THtmlLink.Create)]) do begin
      Target.AsString := 'http://user:pass@www.zdechov.net:80/folder/index.html?param1=value1&param2=value2#Fragment';
      Content := THtmlString.Create;
      THtmlString(Content).Text := 'Odkaz';
    end;
    with Body, THtmlImage(SubItems[SubItems.Add(THtmlImage.Create)]) do begin
      AlternateText := 'Peníze';
      Source.AsString := 'images/favicons/money.gif';
      Size.Width := 16;
      Size.Height := 16;
    end;
  end;
  *)
(*
  Page := THtmlPage.Create;
  with Page do begin
    Title := 'ZdìchovNET - Úvodní stránka';
    with Body do begin
      with TDiv(SubItems[SubItems.Add(TDiv.Create)]) do begin

      end;
    end;

  end;
  Memo1.Lines.Text := Page.GenerateOutput;
  *)
  //Memo1.Lines.Text := HtmlPage.AsXmlDocument.AsString;
//  Xmldocument.Free;

  IdHTTPServer1 := TIdHTTPServer.Create;
  with IdHTTPServer1 do begin
    SocketHandle := Bindings.Add;
    with SocketHandle do begin
      IP := '0.0.0.0';
      Port := 8000;
    end;
    DefaultPort := 25000;
    AutoStartSession := True;
    ServerSoftware := 'Chronosoft web server';
    SessionTimeOut := 600000;
    OnSessionStart := IdHTTPServer1SessionStart;
    OnSessionEnd := IdHTTPServer1SessionEnd;
    OnCommandGet := IdHTTPServer1CommandGet;
    SessionState := True;
    Active := True;
  end;
end;

destructor TMainForm.Destroy;
begin
  IdHTTPServer1.Free;
end;

procedure TMainForm.IdHTTPServer1CommandGet(AContext: TIdContext; 
  ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
var
  PathParts: TStringArray;
  QueryParts: TStringArray;
  Output: string;
  User: TUser;
  I: Integer;
begin
  I := 0;
  while (I < UserSessions.Count) and (TUser(UserSessions[I]).SessionId <> ARequestInfo.Session.SessionID) do Inc(I);
  if (I < UserSessions.Count) then User := TUser(UserSessions[I]) else begin
    User := TUser.Create;
    User.Database := Database;
  end;
  PathParts := Explode('/', Copy(ARequestInfo.Document, 2, High(Integer)));
  if PathParts[0] = 'user' then begin
    if PathParts[1] = 'login2' then
      //AResponseInfo.ContentText := '<div class="sysmessage">' +
      //User.Login(ARequestInfo.Params.Values['nick'], ARequestInfo.Params.Values['password']);
      //+ '</div>';
      if Assigned(ARequestInfo.Session) then
        AResponseInfo.ContentText := ARequestInfo.Session.SessionID;
      if Assigned(AResponseInfo.Session) then
        AResponseInfo.ContentText := AResponseInfo.ContentText + ' X' + AResponseInfo.Session.SessionID;
//        AResponseInfo.ContentText := IntToStr(IdHTTPServer1.SessionList
  end else begin
    AResponseInfo.ContentText := '<div class="Title">Pøihlá‘ení uživatele:</div>' +
    '<div class="Form"><form action="/user/login2/" method="post">' +
    '<table><tr><td>Pøezdívka:</td><td><input name="nick"></td></tr>' +
    '<tr><td>Heslo:</td><td><input type="password" name="password"></td></tr>' +
    '</table><input type="submit" value="Pøihlásit"><br>' +
    '</form>' +
    '<a href="?module=user&amp;action=sendpassword">Zaslat heslo na email</a></div>';
  end;
  //AResponseInfo.ContentText := HtmlPage.AsXmlDocument.AsString
  User.Free;
end;

{ TUser }

function TUser.Login(UserName, Password: string): Boolean;
var
  Rows: TDbRows;
begin
  Rows := Database.Select('user', '*', 'username="' + UserName + '"');
  if Rows.Count > 0 then begin
    if Rows[0].Values['password'] = Password then begin
      Result := True;
      LastLogin := Now;

      //Database.Update(
    end;
  end;

end;

procedure TMainForm.IdHTTPServer1SessionStart(Sender: TIdHTTPSession);
begin
  with TUser(UserSessions[UserSessions.Add(TUser.Create)]) do begin
    Database := Self.Database;
    SessionId := Sender.SessionID;
  end;
end;

procedure TMainForm.IdHTTPServer1SessionEnd(Sender: TIdHTTPSession);
var
  I: Integer;
begin
  I := 0;
  while (I < UserSessions.Count) and (TUser(UserSessions[I]).SessionId <> Sender.SessionID) do Inc(I);
  if (I < UserSessions.Count) then
  TUser(UserSessions[I]).Free;
end;

begin
  MainForm := TMainForm.Create;
  ReadLn;
end.