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:
2 edited

Legend:

Unmodified
Added
Removed

  • trunk

    • Property svn:ignore

      •  

        old new  
        22UConfig.pas
        33bin
         4lib

  • 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
Note: See TracChangeset for help on using the changeset viewer.