Changeset 68 for trunk/Components/CoolWeb

Timestamp:

Dec 26, 2011, 12:07:37 PM (13 years ago)

Author:

chronos

Message:

• Upraveno: Testování varianty HTTP serveru jako přímé obsluhy přes TCP. Momentálně není odděleno generování stránek pro použití z více vláken.
• Upraveno: Třída uchování jména počítač nyní pro převod do IPv4 používá ověření správnosti namísto přímého převodu a zahlášení výjimky.

Location:

trunk/Components/CoolWeb

Files:

• Common/UHtmlClasses.pas (modified) (6 diffs)
• Network/UTCPServer.pas (modified) (2 diffs)
• WebServer/UHTTPServer.pas (modified) (4 diffs)
• WebServer/UHTTPServerCGI.pas (modified) (3 diffs)
• WebServer/UHTTPServerTCP.pas (modified) (2 diffs)
• WebServer/UWebApp.pas (modified) (5 diffs)

trunk/Components/CoolWeb/Common/UHtmlClasses.pas

@@ -9 +9 @@
 
 type
+
+  { TDomainAddress }
+
   TDomainAddress = class(TPersistent)
   private
@@ -14 +17 @@
     procedure SetAsString(const Value: string);
   public
-    Levels: array of string;
+    Levels: TListString;
+    constructor Create;
+    destructor Destroy; override;
     property AsString: string read GetAsString write SetAsString;
   end;
 
   TAddrClass = (acA, acB, acC, acD, acE);
+
+  { TIpAddress }
 
   TIpAddress = class(TPersistent)
@@ -32 +39 @@
     Octets: array[0..3] of Byte;
     procedure Assign(Source: TPersistent); override;
+    function IsAddressString(Value: string): Boolean;
     property AsCardinal: Cardinal read GetAsCardinal write SetAsCardinal;
     property AsString: string read GetAsString write SetAsString;
@@ -589 +597 @@
 end;
 
+function TIpAddress.IsAddressString(Value: string): Boolean;
+var
+  Parts: TListString;
+begin
+  Result := True;
+  try
+    Parts := TListString.Create;
+    Parts.Explode(Value, '.', StrToStr);
+    if Parts.Count = 4 then begin
+      if (StrToInt(Parts[3]) < 0) or (StrToInt(Parts[3]) > 255) then Result := False;
+      if (StrToInt(Parts[2]) < 0) or (StrToInt(Parts[2]) > 255) then Result := False;
+      if (StrToInt(Parts[1]) < 0) or (StrToInt(Parts[1]) > 255) then Result := False;
+      if (StrToInt(Parts[0]) < 0) or (StrToInt(Parts[0]) > 255) then Result := False;
+    end else Result := False;
+  finally
+    Parts.Free;
+  end;
+end;
+
 function TIpAddress.GetAddrClass: TAddrClass;
 begin
@@ -704 +731 @@
 
 function TDomainAddress.GetAsString: string;
-var
-  I: Integer;
-begin
-  Result := '';
-  for I := High(Levels) downto 0 do Result := Result + '.' + Levels[I];
-  Delete(Result, 1, 1);
+begin
+  try
+    Levels.Reverse;
+    Result := Levels.Implode('.', StrToStr);
+  finally
+    Levels.Reverse;
+  end;
 end;
 
 procedure TDomainAddress.SetAsString(const Value: string);
-var
-  StrArray: TListString;
-  I: Integer;
-begin
-  try
-    StrArray := TListString.Create;
-    StrArray.Explode(Value, '.', StrToStr);
-    SetLength(Levels, StrArray.Count);
-    for I := 0 to StrArray.Count - 1 do
-      Levels[StrArray.Count - 1 - I] := StrArray[I];
-  finally
-    StrArray.Free;
-  end;
+begin
+  Levels.Explode(Value, '.', StrToStr);
+  Levels.Reverse;
+end;
+
+constructor TDomainAddress.Create;
+begin
+  Levels := TListString.Create;
+end;
+
+destructor TDomainAddress.Destroy;
+begin
+  Levels.Free;
+  inherited Destroy;
 end;
 
@@ -792 +821 @@
 procedure THostAddress.SetAsString(const Value: string);
 begin
-  State := asIpAddress;
-  try
+  if IpAddress.IsAddressString(Value) then begin
+    State := asIpAddress;
     IpAddress.AsString := Value;
-  except
-    on EConvertError do State := asDomainName;
-  end;
-  if State = asDomainName then DomainName.AsString := Value;
+  end else begin
+    State := asDomainName;
+    DomainName.AsString := Value;
+  end;
 end;
 

trunk/Components/CoolWeb/Network/UTCPServer.pas

@@ -31 +31 @@
 
   TClientThreadedPool = class(TThreadPool)
+  protected
+    function NewItemObject: TObject; override;
   private
     FActive: Boolean;
@@ -164 +166 @@
 { TClientThreadedPool }
 
+function TClientThreadedPool.NewItemObject: TObject;
+begin
+  Result := TTCPClientThread.Create;
+  TResetableThread(Result).OnException := ThreadException;
+end;
+
 procedure TClientThreadedPool.SetActive(const AValue: Boolean);
 begin

trunk/Components/CoolWeb/WebServer/UHTTPServer.pas

@@ -37 +37 @@
     Cookies: TCookieList;
     Post: TQueryParameterList;
+    procedure Clear;
     constructor Create;
     destructor Destroy; override;
@@ -48 +49 @@
     Headers: TStringList;
     Cookies: TCookieList;
+    procedure Clear;
     constructor Create;
     destructor Destroy; override;
@@ -232 +234 @@
 { THTTPResponse }
 
+procedure THTTPResponse.Clear;
+begin
+  Content.Clear;
+  Cookies.Clear;
+  Headers.Clear;
+end;
+
 constructor THTTPResponse.Create;
 begin
@@ -267 +276 @@
 
 { THTTPRequest }
+
+procedure THTTPRequest.Clear;
+begin
+  Post.Clear;
+  Content.Clear;
+  QueryParts.Clear;
+  Cookies.Clear;
+  Headers.Clear;
+  Query.Clear;
+end;
 
 constructor THTTPRequest.Create;

trunk/Components/CoolWeb/WebServer/UHTTPServerCGI.pas

@@ -66 +66 @@
       repeat
         Count := InputStream.Read(Buffer[1], Length(Buffer));
-        Request.Content.Write(Buffer[1], Count);
+        if Count > 0 then Request.Content.Write(Buffer[1], Count);
       until Count = 0;
     finally
@@ -77 +77 @@
 
     // Load data
-    if Request.Headers.IndexOfName('Content-length') <> -1 then
+    (*if Request.Headers.IndexOfName('Content-length') <> -1 then
     try
       InputStream := TIOStream.Create(iosInput);
@@ -83 +83 @@
     finally
       InputStream.Free;
-    end;
+    end;  *)
 
     // Load environment variables

trunk/Components/CoolWeb/WebServer/UHTTPServerTCP.pas

@@ -21 +21 @@
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
+    procedure Run; override;
   published
     property MaxConnection: Integer read FMaxConnection write FMaxConnection;
@@ -143 +144 @@
 end;
 
+procedure THTTPServerTCP.Run;
+begin
+  inherited Run;
+  WriteLn('HTTP Server started in TCP mode.');
+  WriteLn('Listen on ' + Socket.Address + ':' + IntToStr(Socket.Port));
+  WriteLn('Press any key to terminate...');
+  Socket.ThreadPool.TotalCount := MaxConnection;
+  Socket.Active := True;
+  ReadLn;
+  WriteLn('Exiting');
+end;
+
 end.
 

trunk/Components/CoolWeb/WebServer/UWebApp.pas

@@ -7 +7 @@
 uses
   Classes, SysUtils, CustApp, SpecializedList, UWebPage, UHTTPSessionFile,
-  UHTTPServer, UHTTPServerCGI;
+  UHTTPServer;
 
 type
+  THTTPServerType = (stCGI, stTCP);
+
   TRegistredPage = class
     Name: string;
@@ -26 +28 @@
   private
     FOnInitialize: TNotifyEvent;
+    FServerType: THTTPServerType;
     procedure DoRun; override;
     function DumpExceptionCallStack(E: Exception): string;
     procedure HTTPServerRequest(HandlerData: THTTPHandlerData);
+    procedure SetServerType(AValue: THTTPServerType);
   public
     Pages: TRegistredPageList;
@@ -39 +43 @@
     destructor Destroy; override;
     property OnInitialize: TNotifyEvent read FOnInitialize write FOnInitialize;
+    property ServerType: THTTPServerType read FServerType write SetServerType;
   end;
 
@@ -49 +54 @@
 
 implementation
+
+uses
+  UHTTPServerCGI, UHTTPServerTCP;
 
 resourcestring
@@ -133 +141 @@
     end else Response.Content.WriteString(SPageNotFound);
   end;
+end;
+
+procedure TWebApp.SetServerType(AValue: THTTPServerType);
+begin
+  if FServerType = AValue then Exit;
+  FServerType := AValue;
+  HTTPServer.Free;
+  case FServerType of
+    stCGI: HTTPServer := THTTPServerCGI.Create(nil);
+    stTCP: HTTPServer := THTTPServerTCP.Create(nil);
+  end;
+  HTTPServer.OnRequest := HTTPServerRequest;
 end;