Changeset 259

Timestamp:

Jul 31, 2011, 8:00:28 PM (13 years ago)

Author:

george

Message:

• Upraveno: Dumping exception to standard output or standard error output.

File:

• Network/CoolWeb/WebServer/UWebApp.pas (modified) (5 diffs)

Network/CoolWeb/WebServer/UWebApp.pas

@@ -27 +27 @@
     FOnInitialize: TNotifyEvent;
     procedure DoRun; override;
+    function DumpExceptionCallStack(E: Exception): string;
     procedure HTTPServerRequest(HandlerData: THTTPHandlerData);
   public
@@ -32 +33 @@
     HTTPServer: THTTPServer;
     HTTPSessionStorageFile: THTTPSessionStorageFile;
+    LogException: Boolean;
+    procedure ShowException(E: Exception); override;
     procedure RegisterPage(PageClass: TWebPageClass; out Reference; Path: string);
     constructor Create(AOwner: TComponent); override;
@@ -56 +59 @@
 end;
 
+
 { TRegistredPageList }
 
@@ -72 +76 @@
 procedure TWebApp.DoRun;
 begin
-  if Assigned(FOnInitialize) then FOnInitialize(Self);
-  HTTPServer.Run;
-  Terminate;
+  try
+    if Assigned(FOnInitialize) then FOnInitialize(Self);
+    HTTPServer.Run;
+  finally
+    Terminate;
+  end;
+end;
+
+function TWebApp.DumpExceptionCallStack(E: Exception): string;
+var
+  I: Integer;
+  Frames: PPointer;
+  Report: string;
+begin
+  Report := 'Program exception! ' + LineEnding +
+    'Stacktrace:' + LineEnding + LineEnding;
+  if E <> nil then begin
+    Report := Report + 'Exception class: ' + E.ClassName + LineEnding +
+    'Message: ' + E.Message + LineEnding;
+  end;
+  Report := Report + BackTraceStrFunc(ExceptAddr);
+  Frames := ExceptFrames;
+  for I := 0 to ExceptFrameCount - 1 do
+    Report := Report + LineEnding + BackTraceStrFunc(PointerArray(Frames)[I]);
+  Result := Report;
 end;
 
@@ -109 +135 @@
 end;
 
+procedure TWebApp.ShowException(E: Exception);
+var
+  hstdout: ^Text;
+begin
+  if not LogException then begin
+    hstdout := @stdout;
+    WriteLn(hstdout^, 'Content-type: text/html');
+    WriteLn(hstdout^);
+    Writeln(hstdout^, 'An unhandled exception occurred: ' + E.Message + '<br>');
+    WriteLn(hstdout^, StringReplace(DumpExceptionCallStack(E), LineEnding, '<br>', [rfReplaceAll]));
+  end else begin
+    hstdout := @stdout;
+    WriteLn(hstdout^, 'Content-type: text/html');
+    WriteLn(hstdout^);
+    WriteLn(hstdout^, 'Error occured during page generation.');
+    hstdout := @stderr;
+    Writeln(hstdout^, 'An unhandled exception occurred: ' + E.Message + '<br>');
+    WriteLn(hstdout^, StringReplace(DumpExceptionCallStack(E), LineEnding, '<br>', [rfReplaceAll]));
+  end;
+end;
+
 constructor TWebApp.Create(AOwner: TComponent);
 begin