Changeset 68 for trunk/Components


Ignore:
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
Files:
7 edited

Legend:

Unmodified
Added
Removed

  • trunk/Components/Common/UResetableThread.pas

    r64 r68  
    5353    FOnException: TExceptionEvent;
    5454    procedure MethodFinish(Sender: TObject);
     55  protected
    5556    procedure ThreadException(Sender: TObject; E: Exception);
    56   protected
    5757    function NewItemObject: TObject; override;
    5858  public

  • trunk/Components/CoolWeb/Common/UHtmlClasses.pas

    r67 r68  
    99
    1010type
     11
     12  { TDomainAddress }
     13
    1114  TDomainAddress = class(TPersistent)
    1215  private
    … …  
    1417    procedure SetAsString(const Value: string);
    1518  public
    16     Levels: array of string;
     19    Levels: TListString;
     20    constructor Create;
     21    destructor Destroy; override;
    1722    property AsString: string read GetAsString write SetAsString;
    1823  end;
    1924
    2025  TAddrClass = (acA, acB, acC, acD, acE);
     26
     27  { TIpAddress }
    2128
    2229  TIpAddress = class(TPersistent)
    … …  
    3239    Octets: array[0..3] of Byte;
    3340    procedure Assign(Source: TPersistent); override;
     41    function IsAddressString(Value: string): Boolean;
    3442    property AsCardinal: Cardinal read GetAsCardinal write SetAsCardinal;
    3543    property AsString: string read GetAsString write SetAsString;
    … …  
    589597end;
    590598
     599function TIpAddress.IsAddressString(Value: string): Boolean;
     600var
     601  Parts: TListString;
     602begin
     603  Result := True;
     604  try
     605    Parts := TListString.Create;
     606    Parts.Explode(Value, '.', StrToStr);
     607    if Parts.Count = 4 then begin
     608      if (StrToInt(Parts[3]) < 0) or (StrToInt(Parts[3]) > 255) then Result := False;
     609      if (StrToInt(Parts[2]) < 0) or (StrToInt(Parts[2]) > 255) then Result := False;
     610      if (StrToInt(Parts[1]) < 0) or (StrToInt(Parts[1]) > 255) then Result := False;
     611      if (StrToInt(Parts[0]) < 0) or (StrToInt(Parts[0]) > 255) then Result := False;
     612    end else Result := False;
     613  finally
     614    Parts.Free;
     615  end;
     616end;
     617
    591618function TIpAddress.GetAddrClass: TAddrClass;
    592619begin
    … …  
    704731
    705732function TDomainAddress.GetAsString: string;
    706 var
    707   I: Integer;
    708 begin
    709   Result := '';
    710   for I := High(Levels) downto 0 do Result := Result + '.' + Levels[I];
    711   Delete(Result, 1, 1);
     733begin
     734  try
     735    Levels.Reverse;
     736    Result := Levels.Implode('.', StrToStr);
     737  finally
     738    Levels.Reverse;
     739  end;
    712740end;
    713741
    714742procedure TDomainAddress.SetAsString(const Value: string);
    715 var
    716   StrArray: TListString;
    717   I: Integer;
    718 begin
    719   try
    720     StrArray := TListString.Create;
    721     StrArray.Explode(Value, '.', StrToStr);
    722     SetLength(Levels, StrArray.Count);
    723     for I := 0 to StrArray.Count - 1 do
    724       Levels[StrArray.Count - 1 - I] := StrArray[I];
    725   finally
    726     StrArray.Free;
    727   end;
     743begin
     744  Levels.Explode(Value, '.', StrToStr);
     745  Levels.Reverse;
     746end;
     747
     748constructor TDomainAddress.Create;
     749begin
     750  Levels := TListString.Create;
     751end;
     752
     753destructor TDomainAddress.Destroy;
     754begin
     755  Levels.Free;
     756  inherited Destroy;
    728757end;
    729758
    … …  
    792821procedure THostAddress.SetAsString(const Value: string);
    793822begin
    794   State := asIpAddress;
    795   try
     823  if IpAddress.IsAddressString(Value) then begin
     824    State := asIpAddress;
    796825    IpAddress.AsString := Value;
    797   except
    798     on EConvertError do State := asDomainName;
    799   end;
    800   if State = asDomainName then DomainName.AsString := Value;
     826  end else begin
     827    State := asDomainName;
     828    DomainName.AsString := Value;
     829  end;
    801830end;
    802831

  • trunk/Components/CoolWeb/Network/UTCPServer.pas

    r61 r68  
    3131
    3232  TClientThreadedPool = class(TThreadPool)
     33  protected
     34    function NewItemObject: TObject; override;
    3335  private
    3436    FActive: Boolean;
    … …  
    164166{ TClientThreadedPool }
    165167
     168function TClientThreadedPool.NewItemObject: TObject;
     169begin
     170  Result := TTCPClientThread.Create;
     171  TResetableThread(Result).OnException := ThreadException;
     172end;
     173
    166174procedure TClientThreadedPool.SetActive(const AValue: Boolean);
    167175begin

  • trunk/Components/CoolWeb/WebServer/UHTTPServer.pas

    r67 r68  
    3737    Cookies: TCookieList;
    3838    Post: TQueryParameterList;
     39    procedure Clear;
    3940    constructor Create;
    4041    destructor Destroy; override;
    … …  
    4849    Headers: TStringList;
    4950    Cookies: TCookieList;
     51    procedure Clear;
    5052    constructor Create;
    5153    destructor Destroy; override;
    … …  
    232234{ THTTPResponse }
    233235
     236procedure THTTPResponse.Clear;
     237begin
     238  Content.Clear;
     239  Cookies.Clear;
     240  Headers.Clear;
     241end;
     242
    234243constructor THTTPResponse.Create;
    235244begin
    … …  
    267276
    268277{ THTTPRequest }
     278
     279procedure THTTPRequest.Clear;
     280begin
     281  Post.Clear;
     282  Content.Clear;
     283  QueryParts.Clear;
     284  Cookies.Clear;
     285  Headers.Clear;
     286  Query.Clear;
     287end;
    269288
    270289constructor THTTPRequest.Create;

  • trunk/Components/CoolWeb/WebServer/UHTTPServerCGI.pas

    r67 r68  
    6666      repeat
    6767        Count := InputStream.Read(Buffer[1], Length(Buffer));
    68         Request.Content.Write(Buffer[1], Count);
     68        if Count > 0 then Request.Content.Write(Buffer[1], Count);
    6969      until Count = 0;
    7070    finally
    … …  
    7777
    7878    // Load data
    79     if Request.Headers.IndexOfName('Content-length') <> -1 then
     79    (*if Request.Headers.IndexOfName('Content-length') <> -1 then
    8080    try
    8181      InputStream := TIOStream.Create(iosInput);
    … …  
    8383    finally
    8484      InputStream.Free;
    85     end;
     85    end;  *)
    8686
    8787    // Load environment variables

  • trunk/Components/CoolWeb/WebServer/UHTTPServerTCP.pas

    r67 r68  
    2121    constructor Create(AOwner: TComponent); override;
    2222    destructor Destroy; override;
     23    procedure Run; override;
    2324  published
    2425    property MaxConnection: Integer read FMaxConnection write FMaxConnection;
    … …  
    143144end;
    144145
     146procedure THTTPServerTCP.Run;
     147begin
     148  inherited Run;
     149  WriteLn('HTTP Server started in TCP mode.');
     150  WriteLn('Listen on ' + Socket.Address + ':' + IntToStr(Socket.Port));
     151  WriteLn('Press any key to terminate...');
     152  Socket.ThreadPool.TotalCount := MaxConnection;
     153  Socket.Active := True;
     154  ReadLn;
     155  WriteLn('Exiting');
     156end;
     157
    145158end.
    146159

  • trunk/Components/CoolWeb/WebServer/UWebApp.pas

    r67 r68  
    77uses
    88  Classes, SysUtils, CustApp, SpecializedList, UWebPage, UHTTPSessionFile,
    9   UHTTPServer, UHTTPServerCGI;
     9  UHTTPServer;
    1010
    1111type
     12  THTTPServerType = (stCGI, stTCP);
     13
    1214  TRegistredPage = class
    1315    Name: string;
    … …  
    2628  private
    2729    FOnInitialize: TNotifyEvent;
     30    FServerType: THTTPServerType;
    2831    procedure DoRun; override;
    2932    function DumpExceptionCallStack(E: Exception): string;
    3033    procedure HTTPServerRequest(HandlerData: THTTPHandlerData);
     34    procedure SetServerType(AValue: THTTPServerType);
    3135  public
    3236    Pages: TRegistredPageList;
    … …  
    3943    destructor Destroy; override;
    4044    property OnInitialize: TNotifyEvent read FOnInitialize write FOnInitialize;
     45    property ServerType: THTTPServerType read FServerType write SetServerType;
    4146  end;
    4247
    … …  
    4954
    5055implementation
     56
     57uses
     58  UHTTPServerCGI, UHTTPServerTCP;
    5159
    5260resourcestring
    … …  
    133141    end else Response.Content.WriteString(SPageNotFound);
    134142  end;
     143end;
     144
     145procedure TWebApp.SetServerType(AValue: THTTPServerType);
     146begin
     147  if FServerType = AValue then Exit;
     148  FServerType := AValue;
     149  HTTPServer.Free;
     150  case FServerType of
     151    stCGI: HTTPServer := THTTPServerCGI.Create(nil);
     152    stTCP: HTTPServer := THTTPServerTCP.Create(nil);
     153  end;
     154  HTTPServer.OnRequest := HTTPServerRequest;
    135155end;
    136156
Note: See TracChangeset for help on using the changeset viewer.