Changeset 33 for trunk


Ignore:
Timestamp:
Sep 13, 2010, 11:20:24 AM (14 years ago)
Author:
george
Message:
  • Přidáno: Druhá varianta projektu pro sestavení TCP serveru.
  • Přidáno: Vlastní obsluha vyjímek a zobrazení ve HTTP tvaru.
  • Opraveno: Zpracování session třídy THTTPSessionStorageMySQL.
Location:
trunk
Files:
8 added
3 deleted
10 edited

Legend:

Unmodified
Added
Removed

  • trunk

    • Property svn:ignore

      •  

        old new  
        22UConfig.pas
        33bin
         4lib

  • trunk/Application/UUser.pas

    r32 r33  
    11unit UUser;
    22
    3 {$mode delphi}
     3{$mode Delphi}{$H+}
    44
    55interface
    66
    77uses
    8   Classes, SysUtils, USqlDatabase, UCGIApplication;
     8  Classes, SysUtils, synacode, USqlDatabase, UCommon, UHTTPServer;
    99
    1010type
    11   TSQLUserList = class
     11  EDuplicateItem = class(Exception);
     12  ENotFound = class(Exception);
     13
     14  { TWebUser }
     15
     16  TWebUser = class
    1217    Database: TSqlDatabase;
     18    HandlerData: THTTPHandlerData;
     19    procedure Delete(Id: Integer);
     20    procedure Add(Name, Password, Email: string);
     21    function GetIdByName(Name: string): Integer;
     22    function GetIdByNamePassword(Name: string; PassWord: string): Integer;
    1323  end;
    1424
    15   TUser = class
     25  { TWebOnlineUser }
    1626
    17   end;
    18 
    19   { TSQLOnlineUser }
    20 
    21   TSQLOnlineUser = class
     27  TWebOnlineUser = class
    2228    Database: TSqlDatabase;
     29    HandlerData: THTTPHandlerData;
    2330    Id: Integer;
    2431    User: Integer;
    25     CGI: TCGIApplication;
    26     procedure Login(Name, Password: string);
    27     function Logout: string;
    2832    procedure Update;
     33    procedure Login(User: Integer);
     34    procedure Logout;
    2935  end;
    3036
    3137implementation
    3238
    33 { TSQLOnlineUser }
     39resourcestring
     40  SDuplicateUserItem = 'User name already used.';
    3441
    35 procedure TSQLOnlineUser.Login(Name, Password: string);
     42{ TOnlineUser }
     43
     44procedure TWebOnlineUser.Update;
     45var
     46  DbRows: TDbRows;
     47  Id: Integer;
     48begin
     49  DbRows := Database.Query('SELECT * FROM `UserOnline` WHERE `SessionId`="' +
     50    HandlerData.Request.Cookies.Values['SessionId'] + '"');
     51  if DbRows.Count > 0 then begin
     52    // Update exited
     53    Id := StrToInt(DbRows[0].Values['Id']);
     54    DbRows.Free;
     55    DbRows := Database.Query('UPDATE `UserOnline` SET `ActivityTime` = NOW() WHERE `Id`=' + IntToStr(Id));
     56  end else begin
     57    // Create new record
     58    DbRows.Free;
     59    DbRows := Database.Query('INSERT INTO `UserOnline` (`User`, `ActivityTime`, `SessionId`) ' +
     60      'VALUES (1, NOW(), "' + HandlerData.Request.Cookies.Values['SessionId'] + '")');
     61    Id := Database.LastInsertId;
     62  end;
     63  DbRows.Destroy;
     64end;
     65
     66procedure TWebOnlineUser.Login(User: Integer);
    3667var
    3768  DbRows: TDbRows;
    3869begin
    3970  Logout;
    40   try
    41     DbRows := Database.Query('UPDATE `UserOnline` SET `User` = ' + IntToStr(User) + ', `LoginTime` = NOW() WHERE `SessionId`="' +
    42       CGI.Cookies.Values['SessionId'] + '"');
    43   finally
    44     DbRows.Free;
    45   end;
     71  DbRows := Database.Query('UPDATE `UserOnline` SET `User` = ' + IntToStr(User) + ', `LoginTime` = NOW() WHERE `SessionId`="' +
     72    HandlerData.Request.Cookies.Values['SessionId'] + '"');
     73  DbRows.Destroy;
    4674  Self.User := User;
    4775end;
    4876
    49 function TSQLOnlineUser.Logout: string;
     77procedure TWebOnlineUser.Logout;
    5078var
    5179  DbRows: TDbRows;
    … …  
    5381  if Id = 1 then Update;
    5482  if User <> 1 then begin
    55     try
    56       DbRows := Database.Query('UPDATE `UserOnline` SET `User` = 1 WHERE `SessionId`="' +
    57         CGI.Cookies.Values['SessionId'] + '"');
    58     finally
    59       DbRows.Free;
    60     end;
     83    DbRows := Database.Query('UPDATE `UserOnline` SET `User` = 1 WHERE `SessionId`="' +
     84      HandlerData.Request.Cookies.Values['SessionId'] + '"');
     85    DbRows.Destroy;
    6186    User := 1;
    6287  end;
    6388end;
    6489
    65 procedure TSQLOnlineUser.Update;
     90{ TUser }
     91
     92procedure TWebUser.Delete(Id: Integer);
    6693begin
     94  Database.Query('DELETE FROM `User` WHERE `Id`=' + IntToStr(Id));
     95end;
    6796
     97procedure TWebUser.Add(Name, Password, Email: string);
     98var
     99  Salt: string;
     100  DbRows: TDbRows;
     101begin
     102  DbRows := Database.Query('SELECT `Id` FROM `User` WHERE `Name`="' + Name + '"');
     103  try
     104    if DbRows.Count = 0 then begin
     105      Salt := EncodeBase64(Copy(BinToHexString(SHA1(FloatToStr(Now))), 1, 8));
     106      Database.Query('INSERT INTO `User` (`Name`, `Password`, `Salt`, `Email`, `RegistrationTime`) VALUES ("' +
     107        Name + '", SHA1(CONCAT("' + Password + '", "' + Salt + '")), "' + Salt +
     108        '", "' + Email + '", NOW())');
     109    end else raise EDuplicateItem.Create(SDuplicateUserItem);
     110  finally
     111    DbRows.Destroy;
     112  end;
     113end;
     114
     115function TWebUser.GetIdByName(Name: string): Integer;
     116var
     117  DbRows: TDbRows;
     118begin
     119  DbRows := Database.Query('SELECT `Id` FROM `User` WHERE `Name`="' + Name + '"');
     120  try
     121    if DbRows.Count = 1 then Result := StrToInt(DbRows[0].ValuesAtIndex[0])
     122      else raise ENotFound.Create('User "' + Name + '" not found');
     123  finally
     124    DBRows.Destroy;
     125  end;
     126end;
     127
     128function TWebUser.GetIdByNamePassword(Name: string; PassWord: string): Integer;
     129var
     130  DbRows: TDbRows;
     131begin
     132  DbRows := Database.Query('SELECT `Id` FROM `User` WHERE `Name`="' + Name + '" AND ' +
     133    '`Password` = SHA1(CONCAT("' + Password + '", Salt))');
     134  try
     135    if DbRows.Count = 1 then Result := StrToInt(DbRows[0].ValuesAtIndex[0])
     136      else raise ENotFound.Create('User "' + Name + '" not found');
     137  finally
     138    DBRows.Destroy;
     139  end;
    68140end;
    69141

  • trunk/Common/USqlDatabase.pas

    r25 r33  
    5252    function GetLastErrorMessage: string;
    5353    function GetLastErrorNumber: Integer;
    54     function CheckError: Boolean;
    5554    function GetCharset: string;
    5655    procedure SetDatabase(const Value: string);
    … …  
    9190implementation
    9291
    93 uses DateUtils, Math;
     92uses
     93  DateUtils, Math;
     94
     95resourcestring
     96  SDatabaseQueryError = 'Database query error: "%s"';
    9497
    9598const
    … …  
    172175    FSession := NewSession;
    173176  end else FConnected := False;
    174   CheckError;
    175   Rows := Query('SET NAMES ' + Encoding);
    176   Rows.Free;
     177
     178  if LastErrorNumber <> 0 then
     179    raise EQueryError.Create(Format(SDatabaseQueryError, [LastErrorMessage]));
     180
     181  try
     182    Rows := Query('SET NAMES ' + Encoding);
     183  finally
     184    Rows.Free;
     185  end;
    177186end;
    178187
    … …  
    197206  System.Delete(DbNames, 1, 1);
    198207  System.Delete(DbValues, 1, 1);
    199   DbResult := Query('INSERT INTO `' + Table + '` (' + DbNames + ') VALUES (' + DbValues + ')');
    200   DbResult.Free;
     208  try
     209    DbResult := Query('INSERT INTO `' + Table + '` (' + DbNames + ') VALUES (' + DbValues + ')');
     210  finally
     211    DbResult.Free;
     212  end;
    201213end;
    202214
    … …  
    210222  RepeatLastAction := False;
    211223  LastQuery := Data;
    212   //if not Connected then NastaveniPripojeni.ShowModal;
    213224  Result := TDbRows.Create;
    214   //repeat
    215225  mysql_query(FSession, PChar(Data));
    216   //until not
    217   CheckError;
    218   //if not CheckError then
    219   begin
    220     DbResult := mysql_store_result(FSession);
    221     if Assigned(DbResult) then begin
    222       Result.Count := mysql_num_rows(DbResult);
    223       for I := 0 to Result.Count - 1 do begin
    224         DbRow := mysql_fetch_row(DbResult);
    225         Result[I] := TAssociativeArray.Create;
    226         with Result[I] do begin
    227           for II := 0 to mysql_num_fields(DbResult) - 1 do begin
    228             Add(mysql_fetch_field_direct(DbResult, II)^.Name +
    229               NameValueSeparator + PChar((DbRow + II)^));
     226  if LastErrorNumber <> 0 then begin
     227    raise EQueryError.Create(Format(SDatabaseQueryError, [Data]));
     228  end;
     229
     230  DbResult := mysql_store_result(FSession);
     231  if Assigned(DbResult) then begin
     232    Result.Count := mysql_num_rows(DbResult);
     233    for I := 0 to Result.Count - 1 do begin
     234      DbRow := mysql_fetch_row(DbResult);
     235      Result[I] := TAssociativeArray.Create;
     236      with Result[I] do begin
     237        for II := 0 to mysql_num_fields(DbResult) - 1 do begin
     238          Add(mysql_fetch_field_direct(DbResult, II)^.Name +
     239            NameValueSeparator + PChar((DbRow + II)^));
    230240          end;
    231241        end;
    232242      end;
    233     end;
    234243  end;
    235244  mysql_free_result(DbResult);
    236   (*
    237   if Assigned(DatabaseIntegrity) then
    238   with DatabaseIntegrity do if not Checking then begin
    239     Check;
    240     DebugLog('Database integrity: Unreferenced='+IntToStr(Unreferenced)+' BadReferences='+IntToStr(BadReferences));
    241   end;
    242   *)
    243245end;
    244246
    … …  
    263265  System.Delete(DbNames, 1, 1);
    264266  System.Delete(DbValues, 1, 1);
    265   DbResult := Query('REPLACE INTO `' + Table + '` (' + DbNames + ') VALUES (' + DbValues + ')');
    266   DbResult.Free;
     267  try
     268    DbResult := Query('REPLACE INTO `' + Table + '` (' + DbNames + ') VALUES (' + DbValues + ')');
     269  finally
     270    DbResult.Free;
     271  end;
    267272end;
    268273
    … …  
    270275begin
    271276  Table := ATable;
    272   Result := Query('SELECT ' + Filter + ' FROM `' + Table + '` WHERE '+Condition);
     277  Result := Query('SELECT ' + Filter + ' FROM `' + Table + '` WHERE ' + Condition);
    273278end;
    274279
    … …  
    289294  end;
    290295  System.Delete(DbValues, 1, 1);
    291   DbResult := Query('UPDATE `' + Table + '` SET (' + DbValues + ') WHERE ' + Condition);
    292   DbResult.Free;
     296  try
     297    DbResult := Query('UPDATE `' + Table + '` SET (' + DbValues + ') WHERE ' + Condition);
     298  finally
     299    DbResult.Free;
     300  end;
    293301end;
    294302
    … …  
    303311begin
    304312  Table := ATable;
    305   DbResult := Query('DELETE FROM `' + Table + '` WHERE ' + Condition);
    306   DbResult.Free;
     313  try
     314    DbResult := Query('DELETE FROM `' + Table + '` WHERE ' + Condition);
     315  finally
     316    DbResult.Free;
     317  end;
    307318end;
    308319
    … …  
    338349begin
    339350  Result := mysql_errno(FSession);
    340 end;
    341 
    342 function TSqlDatabase.CheckError: Boolean;
    343 begin
    344   Result := LastErrorNumber <> 0;
    345   if Result then
    346     raise EQueryError.Create('Database query error: "' + LastErrorMessage + '"');
    347351end;
    348352

  • trunk/Pages/UMainPage.pas

    r27 r33  
    66
    77uses
    8   Classes, SysUtils, USqlDatabase, UCore, UCustomCGIApplication, UHtmlClasses;
    9 
    10 procedure Links(App: TCustomCGIApplication);
    11 procedure History(App: TCustomCGIApplication);
    12 procedure Internet(App: TCustomCGIApplication);
    13 procedure VoIP(App: TCustomCGIApplication);
    14 procedure Hosting(App: TCustomCGIApplication);
    15 procedure About(App: TCustomCGIApplication);
    16 procedure Documents(App: TCustomCGIApplication);
    17 procedure Contact(App: TCustomCGIApplication);
     8  Classes, SysUtils, USqlDatabase, UCore, UCustomApplication, UHtmlClasses,
     9  UHTTPServer;
     10
     11procedure Links(App: TCustomApplication; HandlerData: THTTPHandlerData);
     12procedure History(App: TCustomApplication; HandlerData: THTTPHandlerData);
     13procedure Internet(App: TCustomApplication; HandlerData: THTTPHandlerData);
     14procedure VoIP(App: TCustomApplication; HandlerData: THTTPHandlerData);
     15procedure Hosting(App: TCustomApplication; HandlerData: THTTPHandlerData);
     16procedure About(App: TCustomApplication; HandlerData: THTTPHandlerData);
     17procedure Documents(App: TCustomApplication; HandlerData: THTTPHandlerData);
     18procedure Contact(App: TCustomApplication; HandlerData: THTTPHandlerData);
     19procedure ServerInfo(App: TCustomApplication; HandlerData: THTTPHandlerData);
    1820
    1921implementation
    2022
    21 procedure Links(App: TCustomCGIApplication);
     23procedure Links(App: TCustomApplication; HandlerData: THTTPHandlerData);
    2224begin
    2325  App.HtmlDocument.Title := 'Odkazy';
    … …  
    6567end;
    6668
    67 procedure History(App: TCustomCGIApplication);
     69procedure History(App: TCustomApplication; HandlerData: THTTPHandlerData);
    6870var
    6971  DbRows: TDbRows;
    … …  
    9092end;
    9193
    92 procedure Internet(App: TCustomCGIApplication);
     94procedure Internet(App: TCustomApplication; HandlerData: THTTPHandlerData);
    9395begin
    9496  with App do begin
    … …  
    116118end;
    117119
    118 procedure VoIP(App: TCustomCGIApplication);
     120procedure VoIP(App: TCustomApplication; HandlerData: THTTPHandlerData);
    119121begin
    120122  with App do begin
    … …  
    150152end;
    151153
    152 procedure Hosting(App: TCustomCGIApplication);
     154procedure Hosting(App: TCustomApplication; HandlerData: THTTPHandlerData);
    153155var
    154156  I: Integer;
    … …  
    183185end;
    184186
    185 procedure About(App: TCustomCGIApplication);
     187procedure About(App: TCustomApplication; HandlerData: THTTPHandlerData);
    186188var
    187189  TextBlock: THtmlString;
    … …  
    235237end;
    236238
    237 procedure Documents(App: TCustomCGIApplication);
     239procedure Documents(App: TCustomApplication; HandlerData: THTTPHandlerData);
    238240begin
    239241  with App do begin
    … …  
    259261end;
    260262
    261 procedure Contact(App: TCustomCGIApplication);
     263procedure Contact(App: TCustomApplication; HandlerData: THTTPHandlerData);
    262264begin
    263265  App.HtmlDocument.Title := 'Kontakt';
    … …  
    275277end;
    276278
     279procedure ServerInfo(App: TCustomApplication; HandlerData: THTTPHandlerData);
     280begin
     281  HandlerData.Session.Values['Test'] := 'Tst';
     282  App.HTTPServer.ServerInfo(HandlerData);
     283end;
     284
    277285end.
    278286

  • trunk/WebServer/UHTTPServer.pas

    r32 r33  
    8989  private
    9090    FOnRequest: TRequestEvent;
     91    FShowExceptions: Boolean;
     92    procedure SetShowExceptions(const AValue: Boolean);
    9193  public
    9294    Name: string;
    9395    DocumentRoot: string;
    9496    SessionStorage: THTTPSessionStorage;
     97    ShowExceptions: Boolean;
     98    procedure Run; virtual;
    9599    procedure ErrorResponse(HandlerData: THTTPHandlerData);
    96     procedure Run; virtual;
    97100    procedure FileResponse(HandlerData: THTTPHandlerData);
     101    procedure ServerInfo(HandlerData: THTTPHandlerData); virtual;
    98102    constructor Create;
    99103    destructor Destroy; override;
    100104    property OnRequest: TRequestEvent read FOnRequest write FOnRequest;
    101   end;
     105    property ShowExceptions: Boolean read FShowExceptions write SetShowExceptions;
     106  end;
     107
     108procedure HTTPExceptionShow(Obj: TObject; Addr: Pointer; FrameCount: Longint; Frames: PPointer);
     109procedure HTTPExceptionHide(Obj: TObject; Addr: Pointer; FrameCount: Longint; Frames: PPointer);
     110
    102111
    103112resourcestring
    … …  
    109118{ THTTPServer }
    110119
     120procedure THTTPServer.ServerInfo(HandlerData: THTTPHandlerData);
     121var
     122  I: Integer;
     123begin
     124  with HandlerData, Response.Stream do begin
     125    //Response.Cookies.Values['Test'] := 'Halo';
     126    //Response.Cookies.Values['Test2'] := 'Halo2';
     127
     128    //HTTPServer.SessionHandler.Variables.Values['Session1'] := 'Value1';
     129    //HTTPServer.SessionHandler.Variables.Values['Session2'] := 'Value2';
     130
     131    WriteString('<a href="?ServerInfo">Refresh</a>');
     132
     133    WriteString('<h5>Request HTTP headers</h5>');
     134    for I := 0 to Request.Headers.Count - 1 do begin;
     135      WriteString(Request.Headers.Strings[I] + '<br/>');
     136    end;
     137
     138    WriteString('<h5>Request HTTP cookies</h5>');
     139    for I := 0 to Request.Cookies.Count - 1 do begin;
     140      WriteString(Request.Cookies.Strings[I] + '<br/>');
     141    end;
     142
     143    WriteString('Session id: ' + SessionId);
     144    WriteString('<h5>Session variables</h5>');
     145    for I := 0 to Session.Count - 1 do begin;
     146      WriteString(Session.Strings[I] + '<br/>');
     147    end;
     148
     149    WriteString('<h5>Response HTTP headers</h5>');
     150    with Response.Stream do
     151    for I := 0 to Response.Headers.Count - 1 do begin;
     152      WriteString(Response.Headers.Strings[I] + '<br/>');
     153    end;
     154
     155    WriteString('<h5>Response HTTP cookies</h5>');
     156    for I := 0 to Response.Cookies.Count - 1 do begin;
     157      WriteString(Response.Cookies.Strings[I] + '<br/>');
     158    end;
     159  end;
     160end;
     161
    111162procedure THTTPServer.ErrorResponse(HandlerData: THTTPHandlerData);
    112163begin
    … …  
    114165    WriteString('<html><body>Page ' + Request.Path + ' not found.</body></html>');
    115166  end;
     167end;
     168
     169procedure THTTPServer.SetShowExceptions(const AValue: Boolean);
     170begin
     171  FShowExceptions := AValue;
     172  if AValue then ExceptProc := HTTPExceptionShow
     173    else ExceptProc := HTTPExceptionHide;
    116174end;
    117175
    … …  
    314372end;
    315373
     374procedure HTTPExceptionShow(Obj: TObject; Addr: Pointer; FrameCount: Longint; Frames: PPointer);
     375type
     376  TArrayOfPointer = array of Pointer;
     377var
     378  Message: string;
     379  i: LongInt;
     380  hstdout: ^Text;
     381begin
     382  hstdout := @stdout;
     383  WriteLn(hstdout^, 'Content-type: text/html');
     384  WriteLn(hstdout^);
     385  Writeln(hstdout^, 'An unhandled exception occurred at $', HexStr(PtrUInt(Addr), SizeOf(PtrUInt) * 2), ' :');
     386  if Obj is exception then
     387   begin
     388     Message := Exception(Obj).ClassName + ' : ' + Exception(Obj).Message;
     389     Writeln(hstdout^, Message);
     390   end
     391  else
     392    Writeln(hstdout^, 'Exception object ', Obj.ClassName, ' is not of class Exception.');
     393  Writeln(hstdout^, BackTraceStrFunc(Addr));
     394  if (FrameCount > 0) then
     395    begin
     396      for i := 0 to FrameCount - 1 do
     397        Writeln(hstdout^, BackTraceStrFunc(TArrayOfPointer(Frames)[i]));
     398    end;
     399  Writeln(hstdout^,'');
     400end;
     401
     402procedure HTTPExceptionHide(Obj: TObject; Addr: Pointer; FrameCount: Longint; Frames: PPointer);
     403type
     404  TArrayOfPointer = array of Pointer;
     405var
     406  Message: string;
     407  i: LongInt;
     408  hstdout: ^Text;
     409  hstderr: ^Text;
     410begin
     411  hstdout := @stdout;
     412  hstderr := @stderr;
     413  WriteLn(hstdout^, 'Content-type: text/html');
     414  WriteLn(hstdout^);
     415  WriteLn(hstdout^, 'Error occured during page generation.');
     416  Writeln(hstderr^, 'An unhandled exception occurred at $', HexStr(PtrUInt(Addr), SizeOf(PtrUInt) * 2), ' :');
     417  if Obj is exception then
     418   begin
     419     Message := Exception(Obj).ClassName + ' : ' + Exception(Obj).Message;
     420     Writeln(hstderr^, Message);
     421   end
     422  else
     423    Writeln(hstderr^, 'Exception object ', Obj.ClassName, ' is not of class Exception.');
     424  Writeln(hstderr^, BackTraceStrFunc(Addr));
     425  if (FrameCount > 0) then
     426    begin
     427      for i := 0 to FrameCount - 1 do
     428        Writeln(hstderr^, BackTraceStrFunc(TArrayOfPointer(Frames)[i]));
     429    end;
     430  Writeln(hstderr^,'');
     431end;
     432
    316433end.
    317434

  • trunk/WebServer/UHTTPServerCGI.pas

    r32 r33  
    1818    constructor Create;
    1919    destructor Destroy; override;
    20     procedure SysInfo;
     20    procedure ServerInfo(HandlerData: THTTPHandlerData); override;
    2121  end;
    2222
    … …  
    5050
    5151    // Process cookies
    52     if Request.Headers.IndexOfName('Cookie') <> -1 then
    53       Request.Cookies.Parse(Request.Headers.Values['Cookie']);
     52    if EnvVars.IndexOfName('HTTP_COOKIE') <> -1 then
     53      Request.Cookies.Parse(EnvVars.Values['HTTP_COOKIE']);
    5454
    5555    // Parse query string
    … …  
    6464        Length(EnvVars.Values['REQUEST_URI'])));
    6565
     66    // Load session variables
     67    if Assigned(SessionStorage) then
     68      SessionStorage.Load(HandlerData);
     69
    6670    Response.Stream.Clear;
    6771    Response.Headers.Values['Content-type'] := 'text/html';
    6872
     73    // Execute content handler
    6974    if Assigned(OnRequest) then OnRequest(HandlerData)
    7075      else raise EEmptyHTTPHandler.Create(SEmptyHTTPHandler);
    7176
     77     // Store session variables
     78    if Assigned(SessionStorage) then
     79      SessionStorage.Save(HandlerData);
     80
    7281    with Response do begin
     82      // Generate cookies
     83      for I := 0 to Cookies.Count - 1 do
     84        Headers.Add('Set-Cookie' + Headers.NameValueSeparator + Cookies.Names[I] + '=' + Cookies.ValueFromIndex[I]);
     85        // + ';path=/;expires=' + RFC822DateTime(Now);
     86
    7387      // Generate headers
    7488      for I := 0 to Headers.Count - 1 do begin
    7589        WriteLn(Headers.Names[I] + ': ' + Headers.ValueFromIndex[I]);
    7690      end;
    77 
    78       // Generate cookies
    79       for I := 0 to Cookies.Count - 1 do
    80         Headers.Add('Set-Cookie' + Headers.NameValueSeparator + Cookies.Names[I] + '=' + Cookies.ValueFromIndex[I]);
    81         // + ';path=/;expires=' + RFC822DateTime(Now);
    8291
    8392      WriteLn; // Empty line header separator
    … …  
    92101end;
    93102
    94 procedure THTTPServerCGI.SysInfo;
     103procedure THTTPServerCGI.ServerInfo(HandlerData: THTTPHandlerData);
    95104var
    96105  I: Integer;
    97106begin
    98 (*  Output.Add('<h4>Environment variables:</h4>');
    99   Output.Add('<table border="1">');
    100   for I := 0 to EnvVars.Count - 1 do begin
    101     Output.Add('<tr><td>' + EnvVars.Names[I] + '</td><td>' +
    102       EnvVars.ValueFromIndex[I] + '</td></tr>');
     107  inherited;
     108  with HandlerData, Response.Stream do begin
     109    WriteString('<h5>Environment variables:</h5>');
     110    WriteString('<table border="1">');
     111    for I := 0 to EnvVars.Count - 1 do begin
     112      WriteString('<tr><td>' + EnvVars.Names[I] + '</td><td>' +
     113        EnvVars.ValueFromIndex[I] + '</td></tr>');
     114    end;
     115    WriteString('</table>');
    103116  end;
    104   Output.Add('</table>');*)
    105117end;
    106118

  • trunk/WebServer/UHTTPSessionFile.pas

    r32 r33  
    1010type
    1111
    12   { TFileHTTPSessionStorage }
     12  { THTTPSessionStorageFile }
    1313
    14   TFileHTTPSessionStorage = class(THTTPSessionStorage)
     14  THTTPSessionStorageFile = class(THTTPSessionStorage)
    1515  private
    1616    Lock: TCriticalSection;
    … …  
    3232{ THTTPSession }
    3333
    34 function TFileHTTPSessionStorage.GetNewSessionId: string;
     34function THTTPSessionStorageFile.GetNewSessionId: string;
    3535begin
    3636  Result := BinToHexString(SHA1(FloatToStr(Now)));
    … …  
    3939end;
    4040
    41 procedure TFileHTTPSessionStorage.GetSessionId(HandlerData: THTTPHandlerData);
     41procedure THTTPSessionStorageFile.GetSessionId(HandlerData: THTTPHandlerData);
    4242begin
    4343  with HandlerData do begin
    … …  
    5151end;
    5252
    53 procedure TFileHTTPSessionStorage.Load(HandlerData: THTTPHandlerData);
     53procedure THTTPSessionStorageFile.Load(HandlerData: THTTPHandlerData);
    5454var
    5555  SessionFile: string;
    … …  
    6868end;
    6969
    70 procedure TFileHTTPSessionStorage.Save(HandlerData: THTTPHandlerData);
     70procedure THTTPSessionStorageFile.Save(HandlerData: THTTPHandlerData);
    7171var
    7272  SessionFile: string;
    … …  
    8888end;
    8989
    90 constructor TFileHTTPSessionStorage.Create;
     90constructor THTTPSessionStorageFile.Create;
    9191begin
    9292  inherited Create;
    … …  
    9898end;
    9999
    100 destructor TFileHTTPSessionStorage.Destroy;
     100destructor THTTPSessionStorageFile.Destroy;
    101101begin
    102102  Sessions.Destroy;

  • trunk/WebServer/UHTTPSessionMySQL.pas

    r32 r33  
    1212  { TFileHTTPSessionStorage }
    1313
    14   TMySQLHTTPSessionStorage = class(THTTPSessionStorage)
     14  THTTPSessionStorageMySQL = class(THTTPSessionStorage)
    1515  private
    1616    Lock: TCriticalSection;
    … …  
    3232{ THTTPSession }
    3333
    34 function TMySQLHTTPSessionStorage.GetNewSessionId: string;
     34function THTTPSessionStorageMySQL.GetNewSessionId: string;
    3535var
    3636  DbRows: TDbRows;
     37  Found: Boolean;
    3738begin
    38   DbRows := nil;
    39   Result := BinToHexString(SHA1(FloatToStr(Now)));
    4039  repeat
    41     if Assigned(DbRows) then DbRows.Destroy;
    42     DbRows := SqlDatabase.Query('SELECT * FROM Session WHERE Identification="' +
    43       Result + '"');
    44     if DbRows.Count > 0 then Result := BinToHexString(SHA1(FloatToStr(Now)));
    45   until DbRows.Count > 0;
    46   DbRows.Destroy;
     40    Result := BinToHexString(SHA1(FloatToStr(Now)));
     41    try
     42      DbRows := SqlDatabase.Query('SELECT * FROM `HTTPSession` WHERE `Identification`="' +
     43        Result + '"');
     44      Found := DbRows.Count > 0;
     45    finally
     46      DbRows.Free;
     47    end;
     48  until not Found;
    4749end;
    4850
    49 procedure TMySQLHTTPSessionStorage.GetSessionId(HandlerData: THTTPHandlerData);
     51procedure THTTPSessionStorageMySQL.GetSessionId(HandlerData: THTTPHandlerData);
    5052begin
    5153  with HandlerData do begin
    … …  
    5456    end else begin
    5557      SessionId := GetNewSessionId;
    56       Response.Cookies.Values[SessionIdCookieName] := SessionId;
    5758    end;
    5859  end;
    5960end;
    6061
    61 procedure TMySQLHTTPSessionStorage.Load(HandlerData: THTTPHandlerData);
     62procedure THTTPSessionStorageMySQL.Load(HandlerData: THTTPHandlerData);
    6263var
    6364  DbRows: TDbRows;
    … …  
    6667  try
    6768    Lock.Acquire;
    68     DbRows := SqlDatabase.Query('SELECT * FROM Session WHERE Identification="' +
     69    DbRows := SqlDatabase.Query('SELECT * FROM `HTTPSession` WHERE `Identification`="' +
    6970      HandlerData.SessionId + '"');
    7071    if DbRows.Count > 0 then begin
    … …  
    7374      HandlerData.SessionId := GetNewSessionId;
    7475    end;
    75     DbRows.Destroy;
    7676  finally
     77    DbRows.Free;
    7778    Lock.Release;
    7879  end;
    … …  
    8081end;
    8182
    82 procedure TMySQLHTTPSessionStorage.Save(HandlerData: THTTPHandlerData);
     83procedure THTTPSessionStorageMySQL.Save(HandlerData: THTTPHandlerData);
    8384var
    8485  DbRows: TDbRows;
    … …  
    8788  try
    8889    Lock.Acquire;
    89     DbRows := SqlDatabase.Query('SELECT * FROM Session WHERE Identification="' +
     90    DbRows := SqlDatabase.Query('SELECT * FROM `HTTPSession` WHERE `Identification`="' +
    9091      HandlerData.SessionId + '"');
    9192    if DbRows.Count > 0 then
    92       DbRows2 := SqlDatabase.Query('UPDATE Session SET Variables="' + HandlerData.Session.Text
    93         + '" WHERE Identification="' + HandlerData.SessionId + '"')
    94     else DbRows2 := SqlDatabase.Query('REPLACE Session SET Variables="' + HandlerData.Session.Text
    95         + '" WHERE Identification="' + HandlerData.SessionId + '"');
    96     DbRows2.Destroy;
    97     DbRows.Destroy;
     93      DbRows2 := SqlDatabase.Query('UPDATE `HTTPSession` SET `Variables`="' + HandlerData.Session.Text
     94        + '" WHERE `Identification`="' + HandlerData.SessionId + '", `Time` = NOW()')
     95    else DbRows2 := SqlDatabase.Query('INSERT INTO `HTTPSession` (`Time`,  `Variables`, `Identification`) VALUES (' +
     96    'NOW(), "' + HandlerData.Session.Text + '", "' + HandlerData.SessionId + '")');
    9897    HandlerData.Response.Cookies.Values[SessionIdCookieName] := HandlerData.SessionId;
    9998  finally
     99    DbRows2.Free;
     100    DbRows.Free;
    100101    Lock.Release;
    101102  end;
    … …  
    103104end;
    104105
    105 constructor TMySQLHTTPSessionStorage.Create;
     106constructor THTTPSessionStorageMySQL.Create;
    106107begin
    107108  inherited Create;
    … …  
    109110  Sessions := TStringList.Create;
    110111  SessionIdCookieName := 'SessionId';
    111   SqlDatabase := TSqlDatabase.Create;
    112112  Timeout := 3600;
    113113end;
    114114
    115 destructor TMySQLHTTPSessionStorage.Destroy;
     115destructor THTTPSessionStorageMySQL.Destroy;
    116116begin
    117   SqlDatabase.Destroy;
    118   Sessions.Destroy;
    119   Lock.Destroy;
     117  Sessions.Free;
     118  Lock.Free;
    120119  inherited Destroy;
    121120end;

  • trunk/languages/index.cs.po

    r32 r33  
    1010"Content-Transfer-Encoding: 8bit\n"
    1111
     12#: ucustomapplication.spagenotfound
     13msgctxt "ucustomapplication.spagenotfound"
     14msgid "Page not found"
     15msgstr "Stránka nenalezena"
     16
    1217#: ucustomcgiapplication.spagenotfound
     18msgctxt "ucustomcgiapplication.spagenotfound"
    1319msgid "Page not found"
    1420msgstr "Stránka nenalezena"
    … …  
    3238msgstr ""
    3339
     40#: usqldatabase.sdatabasequeryerror
     41msgid "Database query error: \"%s\""
     42msgstr ""
     43
     44#: uuser.sduplicateuseritem
     45msgid "User name already used."
     46msgstr ""
     47

  • trunk/languages/index.po

    r32 r33  
    22msgstr "Content-Type: text/plain; charset=UTF-8"
    33
     4#: ucustomapplication.spagenotfound
     5msgctxt "ucustomapplication.spagenotfound"
     6msgid "Page not found"
     7msgstr ""
     8
    49#: ucustomcgiapplication.spagenotfound
     10msgctxt "ucustomcgiapplication.spagenotfound"
    511msgid "Page not found"
    612msgstr ""
    … …  
    2430msgstr ""
    2531
     32#: usqldatabase.sdatabasequeryerror
     33msgid "Database query error: \"%s\""
     34msgstr ""
     35
     36#: uuser.sduplicateuseritem
     37msgid "User name already used."
     38msgstr ""
     39
Note: See TracChangeset for help on using the changeset viewer.