Changeset 311
- Timestamp:
- Jan 4, 2012, 2:27:19 PM (13 years ago)
- Location:
- Network/CoolWeb
- Files:
-
- 5 edited
Legend:
- Unmodified
- Added
- Removed
-
Network/CoolWeb/Network/UTCPServer.pas
r295 r311 31 31 32 32 TClientThreadedPool = class(TThreadPool) 33 protected 34 function NewItemObject: TObject; override; 33 35 private 34 36 FActive: Boolean; … … 164 166 { TClientThreadedPool } 165 167 168 function TClientThreadedPool.NewItemObject: TObject; 169 begin 170 Result := TTCPClientThread.Create; 171 TResetableThread(Result).OnException := ThreadException; 172 end; 173 166 174 procedure TClientThreadedPool.SetActive(const AValue: Boolean); 167 175 begin -
Network/CoolWeb/WebServer/UHTTPServer.pas
r250 r311 28 28 29 29 THTTPRequest = class 30 ContentType: string; 31 Content: TMemoryStreamEx; 30 32 Query: TQueryParameterList; 31 33 QueryParts: TListString; … … 34 36 Headers: TStringList; 35 37 Cookies: TCookieList; 38 Post: TQueryParameterList; 39 procedure Clear; 36 40 constructor Create; 37 41 destructor Destroy; override; … … 42 46 THTTPResponse = class 43 47 ContentType: string; 44 Stream: TMemoryStreamEx;48 Content: TMemoryStreamEx; 45 49 Headers: TStringList; 46 50 Cookies: TCookieList; 51 procedure Clear; 47 52 constructor Create; 48 53 destructor Destroy; override; … … 126 131 I: Integer; 127 132 begin 128 with HandlerData, Response. Streamdo begin133 with HandlerData, Response.Content do begin 129 134 //Response.Cookies.Values['Test'] := 'Halo'; 130 135 //Response.Cookies.Values['Test2'] := 'Halo2'; … … 134 139 135 140 WriteString('<a href="?ServerInfo">Refresh</a>'); 141 142 WriteString('<h5>Request HTTP content:</h5>'); 143 WriteStream(Request.Content, Request.Content.Size); 136 144 137 145 WriteString('<h5>Request HTTP headers</h5>'); … … 151 159 end; 152 160 161 WriteString('<h5>Request HTTP POST</h5>'); 162 for I := 0 to Request.Post.Count - 1 do begin; 163 WriteString(Request.Post.Strings[I] + '<br/>'); 164 end; 165 166 167 WriteString('<h5>Response HTTP content:</h5>'); 168 WriteStream(Response.Content, Response.Content.Size); 169 153 170 WriteString('<h5>Response HTTP headers</h5>'); 154 with Response. Streamdo171 with Response.Content do 155 172 for I := 0 to Response.Headers.Count - 1 do begin; 156 173 WriteString(Response.Headers.Strings[I] + '<br/>'); … … 166 183 procedure THTTPServer.ErrorResponse(HandlerData: THTTPHandlerData); 167 184 begin 168 with HandlerData, Response. Streamdo begin185 with HandlerData, Response.Content do begin 169 186 WriteString('<html><body>' + Format(SPageNotFound, [Request.Path]) + '</body></html>'); 170 187 end; … … 193 210 Response.Headers.Values['Content-Type'] := GetMIMEType(Copy(ExtractFileExt(FileName), 2, 255)); 194 211 BinaryFile := TFileStream.Create(FileName, fmOpenRead); 195 Response. Stream.WriteStream(BinaryFile, BinaryFile.Size);212 Response.Content.WriteStream(BinaryFile, BinaryFile.Size); 196 213 BinaryFile.Destroy; 197 214 end else 198 with Response. Streamdo begin215 with Response.Content do begin 199 216 WriteLn(Format(SFileNotFound, [Request.Path])); 200 217 WriteString('<html><body>' + Format(SFileNotFound, [Request.Path]) + '</body></html>'); … … 217 234 { THTTPResponse } 218 235 236 procedure THTTPResponse.Clear; 237 begin 238 Content.Clear; 239 Cookies.Clear; 240 Headers.Clear; 241 end; 242 219 243 constructor THTTPResponse.Create; 220 244 begin 221 Stream:= TMemoryStreamEx.Create;245 Content := TMemoryStreamEx.Create; 222 246 Cookies := TCookieList.Create; 223 247 Headers := TStringList.Create; … … 226 250 destructor THTTPResponse.Destroy; 227 251 begin 228 Stream.Free;252 Content.Free; 229 253 Headers.Free; 230 254 Cookies.Free; … … 253 277 { THTTPRequest } 254 278 279 procedure THTTPRequest.Clear; 280 begin 281 Post.Clear; 282 Content.Clear; 283 QueryParts.Clear; 284 Cookies.Clear; 285 Headers.Clear; 286 Query.Clear; 287 end; 288 255 289 constructor THTTPRequest.Create; 256 290 begin 291 Post := TQueryParameterList.Create; 257 292 Query := TQueryParameterList.Create; 258 293 QueryParts := TListString.Create; 259 294 Headers := TStringList.Create; 260 295 Cookies := TCookieList.Create; 296 Content := TMemoryStreamEx.Create; 261 297 end; 262 298 263 299 destructor THTTPRequest.Destroy; 264 300 begin 301 Content.Free; 302 Post.Free; 265 303 Query.Free; 266 304 QueryParts.Free; -
Network/CoolWeb/WebServer/UHTTPServerCGI.pas
r237 r311 6 6 7 7 uses 8 Classes, SysUtils, UHTTPServer, SpecializedList ;8 Classes, SysUtils, UHTTPServer, SpecializedList, IOStream; 9 9 10 10 type … … 53 53 I: Integer; 54 54 HandlerData: THTTPHandlerData; 55 InputStream: TIOStream; 56 Line: string; 57 Buffer: string; 58 Count: Integer; 55 59 begin 56 60 HandlerData := THTTPHandlerData.Create; 57 61 with HandlerData do try 62 // Load headers 63 try 64 InputStream := TIOStream.Create(iosInput); 65 SetLength(Buffer, 1000); 66 repeat 67 Count := InputStream.Read(Buffer[1], Length(Buffer)); 68 if Count > 0 then Request.Content.Write(Buffer[1], Count); 69 until Count = 0; 70 finally 71 InputStream.Free; 72 end; 73 74 //repeat 75 // ReadLn(Line); 76 //until Line = ''; 77 78 // Load data 79 (*if Request.Headers.IndexOfName('Content-length') <> -1 then 80 try 81 InputStream := TIOStream.Create(iosInput); 82 Request.Content.CopyFrom(InputStream, StrToInt(Request.Headers.Values['Content-length'])); 83 finally 84 InputStream.Free; 85 end; *) 86 58 87 // Load environment variables 59 88 for I := 0 to GetEnvironmentVariableCount - 1 do begin … … 80 109 SessionStorage.Load(HandlerData); 81 110 82 Response.Stream.Clear; 111 // Load post data 112 if EnvVars.IndexOfName('REQUEST_METHOD') <> -1 then begin 113 if EnvVars.Values['REQUEST_METHOD'] = 'POST' then begin 114 Request.Content.Position := 0; 115 Buffer := Request.Content.ReadString; 116 Request.Post.Parse(Buffer); 117 end; 118 end; 119 120 Response.Content.Clear; 83 121 Response.Headers.Values['Content-type'] := 'text/html'; 84 122 … … 105 143 106 144 // Emit page content 107 Stream.Position := 0;108 WriteLn( Stream.ReadString);145 Content.Position := 0; 146 WriteLn(Content.ReadString); 109 147 end; 110 148 finally … … 118 156 begin 119 157 inherited; 120 with HandlerData, Response. Streamdo begin158 with HandlerData, Response.Content do begin 121 159 WriteString('<h5>' + SEnvironmentVariables + '</h5>'); 122 160 WriteString('<table border="1">'); -
Network/CoolWeb/WebServer/UHTTPServerTCP.pas
r237 r311 21 21 constructor Create(AOwner: TComponent); override; 22 22 destructor Destroy; override; 23 procedure Run; override; 23 24 published 24 25 property MaxConnection: Integer read FMaxConnection write FMaxConnection; … … 88 89 SessionStorage.Load(HandlerData); 89 90 90 Response. Stream.Clear;91 Response.Content.Clear; 91 92 Response.Headers.Values['Content-Type'] := 'text/html'; 92 93 … … 100 101 with Response do begin 101 102 SendString('HTTP/1.0 200 OK'#13#10); 102 Headers.Values['Content-Length'] := IntToStr( Stream.Size);103 Headers.Values['Content-Length'] := IntToStr(Content.Size); 103 104 Headers.Values['Connection'] := 'close'; 104 105 Headers.Values['Date'] := RFC822DateTime(Now); … … 115 116 end; 116 117 SendString(#13#10); 117 SendBuffer( Stream.Memory, Stream.Size);118 SendBuffer(Content.Memory, Content.Size); 118 119 SendString(#13#10); 119 120 end; … … 143 144 end; 144 145 146 procedure THTTPServerTCP.Run; 147 begin 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'); 156 end; 157 145 158 end. 146 159 -
Network/CoolWeb/WebServer/UWebApp.pas
r259 r311 7 7 uses 8 8 Classes, SysUtils, CustApp, SpecializedList, UWebPage, UHTTPSessionFile, 9 UHTTPServer , UHTTPServerCGI;9 UHTTPServer; 10 10 11 11 type 12 THTTPServerType = (stCGI, stTCP); 13 12 14 TRegistredPage = class 13 15 Name: string; … … 25 27 TWebApp = class(TCustomApplication) 26 28 private 29 FOnBeforePageProduce: TOnProduceEvent; 27 30 FOnInitialize: TNotifyEvent; 31 FServerType: THTTPServerType; 28 32 procedure DoRun; override; 29 33 function DumpExceptionCallStack(E: Exception): string; 30 34 procedure HTTPServerRequest(HandlerData: THTTPHandlerData); 35 procedure SetServerType(AValue: THTTPServerType); 31 36 public 32 37 Pages: TRegistredPageList; … … 38 43 constructor Create(AOwner: TComponent); override; 39 44 destructor Destroy; override; 45 property OnBeforePageProduce: TOnProduceEvent read FOnBeforePageProduce write FOnBeforePageProduce; 40 46 property OnInitialize: TNotifyEvent read FOnInitialize write FOnInitialize; 47 property ServerType: THTTPServerType read FServerType write SetServerType; 41 48 end; 42 49 … … 49 56 50 57 implementation 58 59 uses 60 UHTTPServerCGI, UHTTPServerTCP; 51 61 52 62 resourcestring … … 125 135 //Request.QueryParts[0] := 'uzivatel'; 126 136 //Request.QueryParts[1] := 'prihlaseni'; 137 if Assigned(FOnBeforePageProduce) then 138 FOnBeforePageProduce(HandlerData); 127 139 128 140 if Request.QueryParts.Count > 0 then PageName := Request.QueryParts[0] … … 131 143 if Assigned(Page) then begin 132 144 Page.Page.OnProduce(HandlerData); 133 end else Response.Stream.WriteString(SPageNotFound); 134 end; 145 end else Response.Content.WriteString(SPageNotFound); 146 end; 147 end; 148 149 procedure TWebApp.SetServerType(AValue: THTTPServerType); 150 begin 151 if FServerType = AValue then Exit; 152 FServerType := AValue; 153 HTTPServer.Free; 154 case FServerType of 155 stCGI: HTTPServer := THTTPServerCGI.Create(nil); 156 stTCP: HTTPServer := THTTPServerTCP.Create(nil); 157 end; 158 HTTPServer.OnRequest := HTTPServerRequest; 135 159 end; 136 160 … … 152 176 hstdout := @stderr; 153 177 Writeln(hstdout^, 'An unhandled exception occurred: ' + E.Message + '<br>'); 154 WriteLn(hstdout^, StringReplace(DumpExceptionCallStack(E), LineEnding, '<br>', [rfReplaceAll]));178 WriteLn(hstdout^, DumpExceptionCallStack(E)); 155 179 end; 156 180 end;
Note:
See TracChangeset
for help on using the changeset viewer.