Changeset 86


Ignore:
Timestamp:
Dec 17, 2009, 8:25:15 AM (15 years ago)
Author:
george
Message:
  • Přidáno: Zobrazení ServerInfo.
  • Přidáno: Zpracování HTTP Cookies.
Location:
branches/DirectWeb
Files:
3 edited

Legend:

Unmodified
Added
Removed

  • branches/DirectWeb/UHTTPServer.pas

    r85 r86  
    66
    77uses
    8   Classes, SysUtils, UTCPServer, UCommon, UMemoryStreamEx, UMIMEType;
     8  Classes, SysUtils, UTCPServer, UCommon, UMemoryStreamEx, UMIMEType,
     9  Synautil;
    910
    1011type
    1112
    12   { TQueryString }
    13 
    14   TQueryString = class(TStringList)
    15     procedure Parse(QueryString: string);
     13  TQueryParameterList = class(TStringList)
     14    procedure Parse(Text: string);
    1615    function Syntetize: string;
    1716  end;
    1817
     18  { TCookieList }
     19
     20  TCookieList = class(TStringList)
     21    procedure Parse(Text: string);
     22    function Syntetize: string;
     23  end;
     24
    1925  { THTTPRequest }
    2026
    2127  THTTPRequest = class
    22     Query: TQueryString;
     28    Query: TQueryParameterList;
    2329    Path: string;
    2430    Host: string;
    2531    Method: string;
     32    Headers: TStringList;
     33    Cookies: TCookieList;
    2634    constructor Create;
    2735    destructor Destroy; override;
    … …  
    3442    Stream: TMemoryStreamEx;
    3543    Headers: TStringList;
     44    Cookies: TCookieList;
    3645    constructor Create;
    3746    destructor Destroy; override;
    … …  
    7887  RequestHandler: TRequestHandler;
    7988  Line: string;
     89  LineIndex: Integer;
    8090  LineParts: array of string;
    8191  Request: THTTPRequest;
    … …  
    90100    Response.Headers.Values['Server'] := Name;
    91101    Request := THTTPRequest.Create;
     102    LineIndex := 0;
    92103    repeat
    93104      Line := RecvString(10000);
    94105      LineParts := Explode(' ', Line);
    95       if Length(LineParts) > 0 then begin
    96         if (LineParts[0] = 'GET') or (LineParts[0] = 'HEAD') or
    97         (LineParts[0] = 'POST') then begin
    98           if Pos('?', LineParts[1]) > 0 then begin
    99             Request.Path := Copy(LineParts[1], 1, Pos('?', LineParts[1]) - 1);
    100             Request.Query.Parse(Copy(LineParts[1], Pos('?', LineParts[1]) + 1, Length(LineParts[1])));
    101           end else Request.Path := LineParts[1];
    102           Request.Method := LineParts[0];
    103         end else
    104         if LineParts[0] = 'Host:' then Request.Host := LineParts[1];
     106      if (LineIndex = 0) and (Length(LineParts) >= 3) then begin
     107        Request.Method := LineParts[0];
     108        if Pos('?', LineParts[1]) > 0 then begin
     109          Request.Path := Copy(LineParts[1], 1, Pos('?', LineParts[1]) - 1);
     110          Request.Query.Parse(Copy(LineParts[1], Pos('?', LineParts[1]) + 1, Length(LineParts[1])));
     111        end else Request.Path := LineParts[1];
     112      end else
     113      if (Length(LineParts) >= 2) and (LineParts[0][Length(LineParts[0])] = ':') then begin
     114        LineParts[0] := Copy(LineParts[0], 1, Length(LineParts[0]) - 1);
     115        Request.Headers.Values[LineParts[0]] := LineParts[1];
    105116      end;
     117      Inc(LineIndex);
    106118    until Line = '';
    107119
     120    // Parse cookies
     121    if Request.Cookies.IndexOfName('Cookie') <> -1 then
     122    Request.Cookies.Parse(Request.Headers.Values['Cookie']);
     123
    108124    Response.Stream.Clear;
     125    Response.Headers.Values['Content-Type'] := 'text/html';
     126
    109127    WriteLn('Requested path: ' + Request.Path);
    110128    RequestHandler := RequestHandlerList.IndexOfName(Request.Path);
    … …  
    115133    with Response do begin
    116134      SendString('HTTP/1.0 200 OK'#13#10);
    117       SendString('Content-Length: ' + IntToStr(Stream.Size) + #13#10);
    118       SendString('Connection: close'#13#10);
    119       //SendString('Date: ' + RFC822DateTime(Now) + #13#10);
    120       // Send additional headers
     135      Headers.Values['Content-Length'] := IntToStr(Stream.Size);
     136      Headers.Values['Connection'] := 'close';
     137      Headers.Values['Date'] := RFC822DateTime(Now);
     138
     139      // Handle cookies
     140      for I := 0 to Cookies.Count - 1 do
     141        Headers.Values['Set-Cookie'] := Cookies.Names[I] + '=' + Cookies.ValueFromIndex[I];
     142        // + ';path=/;expires=' + RFC822DateTime(Now);
     143
     144      // Send headers
    121145      for I := 0 to Headers.Count - 1 do
    122146        SendString(Headers.Names[I] + ': ' + Headers.ValueFromIndex[I] + #13#10);
    … …  
    180204begin
    181205  Stream := TMemoryStreamEx.Create;
     206  Cookies := TCookieList.Create;
    182207  Headers := TStringList.Create;
    183   Headers.Values['Content-Type'] := 'text/html';
    184208end;
    185209
    … …  
    214238constructor THTTPRequest.Create;
    215239begin
    216   Query := TQueryString.Create;
     240  Query := TQueryParameterList.Create;
     241  Headers := TStringList.Create;
     242  Cookies := TCookieList.Create;
    217243end;
    218244
    … …  
    220246begin
    221247  Query.Destroy;
     248  Headers.Destroy;
    222249  inherited Destroy;
    223250end;
    224251
    225 { TQueryString }
    226 
    227 procedure TQueryString.Parse(QueryString: string);
     252{ TQueryParameterList }
     253
     254procedure TQueryParameterList.Parse(Text: string);
    228255var
    229256  I: Integer;
    … …  
    231258  Pair: TArrayOfString;
    232259begin
    233   Parts := Explode('&', QueryString);
     260  Clear;
     261  Parts := Explode('&', Text);
    234262  for I := 0 to Length(Parts) - 1 do begin
    235263    Pair := Explode('=', Parts[I]);
    236     Values[Pair[0]] := Pair[1];
    237   end;
    238 end;
    239 
    240 function TQueryString.Syntetize: string;
     264    if Length(Pair) >= 2 then
     265      Values[Pair[0]] := Pair[1];
     266  end;
     267end;
     268
     269function TQueryParameterList.Syntetize: string;
    241270var
    242271  I: Integer;
    … …  
    246275    Result := Result + '&amp;' + Names[I] + '=' + ValueFromIndex[I];
    247276  Result := Copy(Result, 6, Length(Result));
    248 
     277end;
     278
     279{ TCookieList }
     280
     281procedure TCookieList.Parse(Text: string);
     282var
     283  I: Integer;
     284  Parts: TArrayOfString;
     285  Pair: TArrayOfString;
     286begin
     287  Clear;
     288  Parts := Explode(';', Text);
     289  for I := 0 to Length(Parts) - 1 do begin
     290    Pair := Explode('=', Parts[I]);
     291    if Length(Pair) >= 2 then
     292      Values[Trim(Pair[0])] := Trim(Pair[1]);
     293  end;
     294end;
     295
     296function TCookieList.Syntetize: string;
     297var
     298  I: Integer;
     299begin
     300  Result := '';
     301  for I := 0 to Count - 1 do
     302    Result := Result + '; ' + Names[I] + '=' + ValueFromIndex[I];
     303  Result := Copy(Result, 2, Length(Result));
    249304end;
    250305

  • branches/DirectWeb/UWebServer.pas

    r85 r86  
    2323    function PagesList(URL: string; Page, TotalCount, CountPerPage: Integer
    2424      ): string;
     25    procedure ServerInfo(Request: THTTPRequest; Response: THTTPResponse);
    2526  public
    2627    HTTPServer: THTTPServer;
    … …  
    144145  OrderDirection: string;
    145146  Title: string;
    146   LinkQuery: TQueryString;
     147  LinkQuery: TQueryParameterList;
    147148begin
    148149  SqlDatabase := TSqlDatabase.Create;
    … …  
    165166      ' ORDER BY ' + OrderColumn + ' ' + OrderDirection);
    166167
    167     LinkQuery := TQueryString.Create;
     168    LinkQuery := TQueryParameterList.Create;
    168169    LinkQuery.Assign(Request.Query);
    169170
    … …  
    209210  OrderDirection: string;
    210211  Title: string;
    211   LinkQuery: TQueryString;
     212  LinkQuery: TQueryParameterList;
    212213begin
    213214  SqlDatabase := TSqlDatabase.Create;
    … …  
    237238end;
    238239
     240procedure TWebServer.ServerInfo(Request: THTTPRequest; Response: THTTPResponse);
     241var
     242  I: Integer;
     243begin
     244  with Response.Stream do begin
     245    Response.Cookies.Values['Test'] := 'Halo';
     246
     247    WriteString('<a href="?ServerInfo">Refresh</a>');
     248
     249    WriteString('<h5>Request HTTP headers</h5>');
     250
     251    for I := 0 to Request.Headers.Count - 1 do begin;
     252      WriteString(Request.Headers.Strings[I] + '<br/>');
     253    end;
     254
     255    WriteString('<h5>Response HTTP headers</h5>');
     256    with Response.Stream do
     257    for I := 0 to Response.Headers.Count - 1 do begin;
     258      WriteString(Response.Headers.Strings[I] + '<br/>');
     259    end;
     260  end;
     261end;
     262
    239263procedure TWebServer.SendIndex(Request: THTTPRequest; Response: THTTPResponse);
    240264begin
    … …  
    297321      Add('/ViewList', ViewList);
    298322      Add('/ViewItem', ViewItem);
     323      Add('/ServerInfo', ServerInfo);
    299324    end;
    300325  end;

  • branches/DirectWeb/WoWHostingWebServer.lpi

    r85 r86  
    7676        <IsPartOfProject Value="True"/>
    7777        <UnitName Value="UHTTPServer"/>
    78         <CursorPos X="23" Y="153"/>
    79         <TopLine Value="141"/>
     78        <CursorPos X="37" Y="141"/>
     79        <TopLine Value="123"/>
    8080        <EditorIndex Value="4"/>
    8181        <UsageCount Value="200"/>
    … …  
    8484      <Unit6>
    8585        <Filename Value="..\..\..\..\..\Programy\Lazarus_0.9.29\fpc\2.3.1\source\rtl\objpas\classes\classesh.inc"/>
    86         <CursorPos X="22" Y="1431"/>
    87         <TopLine Value="1426"/>
     86        <CursorPos X="14" Y="556"/>
     87        <TopLine Value="539"/>
     88        <EditorIndex Value="5"/>
    8889        <UsageCount Value="77"/>
     90        <Loaded Value="True"/>
    8991      </Unit6>
    9092      <Unit7>
    … …  
    9395        <CursorPos X="13" Y="1802"/>
    9496        <TopLine Value="1797"/>
    95         <EditorIndex Value="8"/>
     97        <EditorIndex Value="9"/>
    9698        <UsageCount Value="100"/>
    9799        <Loaded Value="True"/>
    … …  
    113115        <CursorPos X="45" Y="15"/>
    114116        <TopLine Value="1"/>
    115         <EditorIndex Value="5"/>
     117        <EditorIndex Value="6"/>
    116118        <UsageCount Value="200"/>
    117119        <Loaded Value="True"/>
    … …  
    130132        <CursorPos X="24" Y="61"/>
    131133        <TopLine Value="1"/>
    132         <UsageCount Value="74"/>
     134        <UsageCount Value="76"/>
    133135      </Unit11>
    134136      <Unit12>
    135137        <Filename Value="..\..\..\..\..\Programy\Lazarus_0.9.29\fpc\2.3.1\source\rtl\objpas\classes\stringl.inc"/>
    136         <CursorPos X="3" Y="193"/>
    137         <TopLine Value="186"/>
     138        <CursorPos X="41" Y="704"/>
     139        <TopLine Value="690"/>
    138140        <UsageCount Value="11"/>
    139141      </Unit12>
    … …  
    150152        <CursorPos X="3" Y="130"/>
    151153        <TopLine Value="121"/>
    152         <EditorIndex Value="7"/>
    153         <UsageCount Value="73"/>
     154        <EditorIndex Value="8"/>
     155        <UsageCount Value="75"/>
    154156        <Loaded Value="True"/>
    155157      </Unit14>
    … …  
    160162        <CursorPos X="17" Y="41"/>
    161163        <TopLine Value="25"/>
    162         <EditorIndex Value="6"/>
    163         <UsageCount Value="73"/>
     164        <EditorIndex Value="7"/>
     165        <UsageCount Value="75"/>
    164166        <Loaded Value="True"/>
    165167      </Unit15>
    … …  
    170172        <TopLine Value="330"/>
    171173        <EditorIndex Value="2"/>
    172         <UsageCount Value="35"/>
     174        <UsageCount Value="36"/>
    173175        <Loaded Value="True"/>
    174176      </Unit16>
    … …  
    202204        <IsPartOfProject Value="True"/>
    203205        <UnitName Value="UWebServer"/>
    204         <CursorPos X="31" Y="295"/>
    205         <TopLine Value="277"/>
     206        <CursorPos X="35" Y="245"/>
     207        <TopLine Value="231"/>
    206208        <EditorIndex Value="1"/>
    207         <UsageCount Value="63"/>
     209        <UsageCount Value="65"/>
    208210        <Loaded Value="True"/>
    209211      </Unit21>
    … …  
    220222        <CursorPos X="32" Y="11"/>
    221223        <TopLine Value="1"/>
    222         <EditorIndex Value="10"/>
    223         <UsageCount Value="21"/>
     224        <EditorIndex Value="11"/>
     225        <UsageCount Value="23"/>
    224226        <Loaded Value="True"/>
    225227        <SyntaxHighlighter Value="XML"/>
    … …  
    230232        <CursorPos X="1" Y="8"/>
    231233        <TopLine Value="1"/>
    232         <EditorIndex Value="9"/>
    233         <UsageCount Value="21"/>
     234        <EditorIndex Value="10"/>
     235        <UsageCount Value="23"/>
    234236        <Loaded Value="True"/>
    235237        <SyntaxHighlighter Value="None"/>
    … …  
    238240    <JumpHistory Count="30" HistoryIndex="29">
    239241      <Position1>
    240         <Filename Value="UWebServer.pas"/>
    241         <Caret Line="47" Column="16" TopLine="30"/>
     242        <Filename Value="UHTTPServer.pas"/>
     243        <Caret Line="108" Column="1" TopLine="91"/>
    242244      </Position1>
    243245      <Position2>
    244         <Filename Value="UWebServer.pas"/>
    245         <Caret Line="48" Column="39" TopLine="31"/>
     246        <Filename Value="UHTTPServer.pas"/>
     247        <Caret Line="109" Column="1" TopLine="92"/>
    246248      </Position2>
    247249      <Position3>
    248         <Filename Value="UWebServer.pas"/>
    249         <Caret Line="11" Column="9" TopLine="1"/>
     250        <Filename Value="UHTTPServer.pas"/>
     251        <Caret Line="111" Column="1" TopLine="94"/>
    250252      </Position3>
    251253      <Position4>
    252         <Filename Value="UWebServer.pas"/>
    253         <Caret Line="36" Column="29" TopLine="7"/>
     254        <Filename Value="UHTTPServer.pas"/>
     255        <Caret Line="122" Column="13" TopLine="106"/>
    254256      </Position4>
    255257      <Position5>
    256         <Filename Value="UWebServer.pas"/>
    257         <Caret Line="35" Column="34" TopLine="19"/>
     258        <Filename Value="UHTTPServer.pas"/>
     259        <Caret Line="85" Column="23" TopLine="68"/>
    258260      </Position5>
    259261      <Position6>
    260         <Filename Value="UWebServer.pas"/>
    261         <Caret Line="290" Column="22" TopLine="261"/>
     262        <Filename Value="UHTTPServer.pas"/>
     263        <Caret Line="21" Column="15" TopLine="1"/>
    262264      </Position6>
    263265      <Position7>
    264         <Filename Value="UWebServer.pas"/>
    265         <Caret Line="272" Column="19" TopLine="255"/>
     266        <Filename Value="UHTTPServer.pas"/>
     267        <Caret Line="44" Column="26" TopLine="16"/>
    266268      </Position7>
    267269      <Position8>
    268         <Filename Value="UWebServer.pas"/>
    269         <Caret Line="275" Column="1" TopLine="259"/>
     270        <Filename Value="UHTTPServer.pas"/>
     271        <Caret Line="282" Column="1" TopLine="259"/>
    270272      </Position8>
    271273      <Position9>
    272         <Filename Value="UWebServer.pas"/>
    273         <Caret Line="272" Column="20" TopLine="262"/>
     274        <Filename Value="UHTTPServer.pas"/>
     275        <Caret Line="249" Column="29" TopLine="232"/>
    274276      </Position9>
    275277      <Position10>
    276         <Filename Value="WoWHostingWebServer.lpr"/>
    277         <Caret Line="14" Column="1" TopLine="1"/>
     278        <Filename Value="UWebServer.pas"/>
     279        <Caret Line="12" Column="22" TopLine="1"/>
    278280      </Position10>
    279281      <Position11>
    280         <Filename Value="WoWHostingWebServer.lpr"/>
    281         <Caret Line="18" Column="18" TopLine="1"/>
     282        <Filename Value="UWebServer.pas"/>
     283        <Caret Line="147" Column="33" TopLine="130"/>
    282284      </Position11>
    283285      <Position12>
    284         <Filename Value="WoWHostingWebServer.lpr"/>
    285         <Caret Line="20" Column="11" TopLine="1"/>
     286        <Filename Value="UWebServer.pas"/>
     287        <Caret Line="168" Column="37" TopLine="151"/>
    286288      </Position12>
    287289      <Position13>
    288         <Filename Value="WoWHostingWebServer.lpr"/>
    289         <Caret Line="21" Column="1" TopLine="1"/>
     290        <Filename Value="UHTTPServer.pas"/>
     291        <Caret Line="121" Column="24" TopLine="98"/>
    290292      </Position13>
    291293      <Position14>
    292         <Filename Value="WoWHostingWebServer.lpr"/>
    293         <Caret Line="16" Column="31" TopLine="1"/>
     294        <Filename Value="UWebServer.pas"/>
     295        <Caret Line="245" Column="35" TopLine="231"/>
    294296      </Position14>
    295297      <Position15>
    296         <Filename Value="WoWHostingWebServer.lpr"/>
    297         <Caret Line="18" Column="31" TopLine="1"/>
     298        <Filename Value="UHTTPServer.pas"/>
     299        <Caret Line="289" Column="19" TopLine="271"/>
    298300      </Position15>
    299301      <Position16>
    300         <Filename Value="WoWHostingWebServer.lpr"/>
    301         <Caret Line="19" Column="19" TopLine="1"/>
     302        <Filename Value="UHTTPServer.pas"/>
     303        <Caret Line="284" Column="1" TopLine="267"/>
    302304      </Position16>
    303305      <Position17>
    304         <Filename Value="WoWHostingWebServer.lpr"/>
    305         <Caret Line="23" Column="16" TopLine="1"/>
     306        <Filename Value="UHTTPServer.pas"/>
     307        <Caret Line="285" Column="1" TopLine="268"/>
    306308      </Position17>
    307309      <Position18>
    308         <Filename Value="WoWHostingWebServer.lpr"/>
    309         <Caret Line="20" Column="1" TopLine="1"/>
     310        <Filename Value="UHTTPServer.pas"/>
     311        <Caret Line="286" Column="1" TopLine="269"/>
    310312      </Position18>
    311313      <Position19>
    312         <Filename Value="UTCPServer.pas"/>
    313         <Caret Line="42" Column="32" TopLine="25"/>
     314        <Filename Value="UHTTPServer.pas"/>
     315        <Caret Line="287" Column="1" TopLine="270"/>
    314316      </Position19>
    315317      <Position20>
    316         <Filename Value="UTCPServer.pas"/>
    317         <Caret Line="80" Column="10" TopLine="74"/>
     318        <Filename Value="UHTTPServer.pas"/>
     319        <Caret Line="288" Column="1" TopLine="271"/>
    318320      </Position20>
    319321      <Position21>
    320         <Filename Value="..\..\..\..\Knihovny\Free Pascal\synapse\blcksock.pas"/>
    321         <Caret Line="1802" Column="13" TopLine="1797"/>
     322        <Filename Value="UHTTPServer.pas"/>
     323        <Caret Line="121" Column="29" TopLine="91"/>
    322324      </Position21>
    323325      <Position22>
    324         <Filename Value="UWebServer.pas"/>
    325         <Caret Line="152" Column="22" TopLine="139"/>
     326        <Filename Value="UHTTPServer.pas"/>
     327        <Caret Line="119" Column="27" TopLine="121"/>
    326328      </Position22>
    327329      <Position23>
    328         <Filename Value="UWebServer.pas"/>
    329         <Caret Line="133" Column="83" TopLine="116"/>
     330        <Filename Value="UHTTPServer.pas"/>
     331        <Caret Line="140" Column="1" TopLine="123"/>
    330332      </Position23>
    331333      <Position24>
    332         <Filename Value="UWebServer.pas"/>
    333         <Caret Line="154" Column="22" TopLine="135"/>
     334        <Filename Value="UHTTPServer.pas"/>
     335        <Caret Line="141" Column="1" TopLine="124"/>
    334336      </Position24>
    335337      <Position25>
    336         <Filename Value="UWebServer.pas"/>
    337         <Caret Line="133" Column="83" TopLine="116"/>
     338        <Filename Value="UHTTPServer.pas"/>
     339        <Caret Line="142" Column="30" TopLine="122"/>
    338340      </Position25>
    339341      <Position26>
    340         <Filename Value="UWebServer.pas"/>
    341         <Caret Line="211" Column="58" TopLine="197"/>
     342        <Filename Value="UHTTPServer.pas"/>
     343        <Caret Line="146" Column="1" TopLine="129"/>
    342344      </Position26>
    343345      <Position27>
    344         <Filename Value="UWebServer.pas"/>
    345         <Caret Line="51" Column="1" TopLine="34"/>
     346        <Filename Value="UHTTPServer.pas"/>
     347        <Caret Line="147" Column="1" TopLine="130"/>
    346348      </Position27>
    347349      <Position28>
    348         <Filename Value="UWebServer.pas"/>
    349         <Caret Line="68" Column="43" TopLine="132"/>
     350        <Filename Value="UHTTPServer.pas"/>
     351        <Caret Line="148" Column="1" TopLine="131"/>
    350352      </Position28>
    351353      <Position29>
    352         <Filename Value="UWebServer.pas"/>
    353         <Caret Line="296" Column="34" TopLine="277"/>
     354        <Filename Value="UHTTPServer.pas"/>
     355        <Caret Line="149" Column="1" TopLine="132"/>
    354356      </Position29>
    355357      <Position30>
    356         <Filename Value="UWebServer.pas"/>
    357         <Caret Line="295" Column="31" TopLine="277"/>
     358        <Filename Value="UHTTPServer.pas"/>
     359        <Caret Line="152" Column="1" TopLine="135"/>
    358360      </Position30>
    359361    </JumpHistory>
    … …  
    374376  </CompilerOptions>
    375377  <Debugging>
     378    <BreakPoints Count="2">
     379      <Item1>
     380        <Source Value="UHTTPServer.pas"/>
     381        <Line Value="286"/>
     382      </Item1>
     383      <Item2>
     384        <Source Value="UHTTPServer.pas"/>
     385        <Line Value="140"/>
     386      </Item2>
     387    </BreakPoints>
    376388    <Exceptions Count="3">
    377389      <Item1>
Note: See TracChangeset for help on using the changeset viewer.