Changeset 89
- Timestamp:
- Dec 18, 2009, 1:42:22 PM (15 years ago)
- Location:
- branches/DirectWeb
- Files:
-
- 5 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/DirectWeb/UPool.pas
r88 r89 33 33 function Acquire: TObject; 34 34 procedure Release(Item: TObject); 35 procedure Allocate;36 35 constructor Create; 37 36 destructor Destroy; override; … … 117 116 end; 118 117 119 procedure TThreadedPool.Allocate;120 var121 I: Integer;122 begin123 Clear;124 for I := 0 to TotalCount - 1 do125 Add(TThreadedPoolItem.Create);126 end;127 128 118 constructor TThreadedPool.Create; 129 119 begin 120 inherited; 130 121 Lock := TCriticalSection.Create; 131 ReleaseEvent := TEvent.Create(nil, False, False, ' ThreadPool');122 ReleaseEvent := TEvent.Create(nil, False, False, ''); 132 123 end; 133 124 … … 143 134 constructor TThreadedPoolItem.Create; 144 135 begin 145 if Assigned(Item) then Item.Destroy;136 Item := nil; 146 137 end; 147 138 -
branches/DirectWeb/UResetableThread.pas
r88 r89 69 69 begin 70 70 Stopped := True; 71 StartEvent := TEvent.Create(nil, False, False, ' TResetableThreadStart');72 StopEvent := TEvent.Create(nil, False, False, ' TResetableThreadStop');71 StartEvent := TEvent.Create(nil, False, False, ''); 72 StopEvent := TEvent.Create(nil, False, False, ''); 73 73 Thread := TResetableThreadExecute.Create(True); 74 74 Thread.Parent := Self; … … 94 94 Parent.Stopped := False; 95 95 Parent.Execute; 96 Parent.Stopped := True; 96 97 Parent.StopEvent.SetEvent; 97 98 end; -
branches/DirectWeb/UTCPServer.pas
r88 r89 101 101 102 102 constructor TTCPServer.Create; 103 var104 I: Integer;105 103 begin 106 104 ThreadPool := TClientThreadedPool.Create; 107 105 ThreadPool.TotalCount := 10; 106 ThreadPool.Active := True; 108 107 109 108 Socket := TTCPBlockSocket.Create; … … 146 145 if Assigned(Parent.FOnClientConnect) then 147 146 Parent.FOnClientConnect(Self); 147 148 Parent.ThreadPool.Release(Self); 148 149 end; 149 150 … … 166 167 I: Integer; 167 168 begin 168 if not FActive and Active then begin 169 Allocate; 169 if not FActive and AValue then begin 170 170 for I := 0 to TotalCount - 1 do begin 171 171 TThreadedPoolItem(Items[I]).Item := TTCPClientThread.Create; 172 172 end; 173 173 end else 174 if FActive and not A ctive then begin174 if FActive and not AValue then begin 175 175 176 176 end; 177 FActive := A ctive;177 FActive := AValue; 178 178 end; 179 179 -
branches/DirectWeb/UWebServer.pas
r88 r89 10 10 UCommon, syncobjs, 11 11 UMemoryStreamEx, 12 UMIMEType, Synautil, 12 UMIMEType, Synautil, UPool, 13 13 USqlDatabase, DOM, XMLRead, UHTMLControls; 14 14 … … 20 20 { TDatabasePool } 21 21 22 TDatabasePool = class(T ObjectList)22 TDatabasePool = class(TThreadedPool) 23 23 private 24 Lock: TCriticalSection; 24 FActive: Boolean; 25 procedure SetActive(const AValue: Boolean); 25 26 public 26 PoolSize: Integer; 27 property Active: Boolean read FActive write SetActive; 28 public 27 29 HostName: string; 28 30 Schema: string; 29 31 UserName: string; 30 32 Password: string; 31 procedure Allocate;32 function Acquire: TSqlDatabase;33 procedure Release(Database: TSqlDatabase);34 33 constructor Create; 35 34 destructor Destroy; override; … … 103 102 Command: string; 104 103 begin 104 LoadConfiguration; 105 DatabasePool.Active := True; 105 106 WriteLn('WoW hosting web server'); 106 LoadConfiguration;107 107 with HTTPServer do begin 108 108 Socket.Active := True; … … 127 127 PageList: TPageList; 128 128 begin 129 SqlDatabase := DatabasePool.Acquire;129 SqlDatabase := TSqlDatabase(DatabasePool.Acquire); 130 130 with HandlerData, Response, Stream, SqlDatabase do 131 131 begin … … 191 191 192 192 DbRows.Destroy; 193 Destroy;194 193 WriteFooter(Stream); 195 194 end; 196 195 PageList.Destroy; 196 DatabasePool.Release(SqlDatabase); 197 197 end; 198 198 … … 207 207 LinkQuery: TQueryParameterList; 208 208 begin 209 SqlDatabase := TSqlDatabase .Create;209 SqlDatabase := TSqlDatabase(DatabasePool.Acquire); 210 210 with HandlerData, Response, Stream, SqlDatabase do 211 211 begin … … 223 223 WriteString('</table>'); 224 224 DbRows.Destroy; 225 Destroy;226 225 WriteFooter(Stream); 227 226 end; 227 DatabasePool.Release(SqlDatabase); 228 228 end; 229 229 … … 269 269 begin 270 270 WriteHeader(Stream); 271 272 271 WriteString('Index'); 273 272 WriteFooter(Stream); 274 273 end; … … 310 309 inherited Create; 311 310 DatabasePool := TDatabasePool.Create; 312 DatabasePool.Capacity := 20; 313 DatabasePool.Allocate; 311 DatabasePool.TotalCount := 20; 314 312 315 313 SessionStorage := TFileHTTPSessionStorage.Create; … … 341 339 { TDatabasePool } 342 340 343 procedure TDatabasePool. Allocate;341 procedure TDatabasePool.SetActive(const AValue: Boolean); 344 342 var 345 343 I: Integer; 346 344 begin 347 for I := 0 to PoolSize - 1 do 348 with TSqlDatabase(Items[Add(TSqlDatabase.Create)]) do begin 349 HostName := Self.HostName; 350 UserName := Self.UserName; 351 Password := Self.Password; 352 Database := Self.Schema; 353 Connect; 354 end; 355 end; 356 357 function TDatabasePool.Acquire: TSqlDatabase; 358 begin 359 360 end; 361 362 procedure TDatabasePool.Release(Database: TSqlDatabase); 363 begin 364 try 365 Lock.Acquire; 366 367 finally 368 Lock.Release; 369 end; 345 if not FActive and AValue then begin 346 for I := 0 to TotalCount - 1 do 347 with TThreadedPoolItem(Items[I]) do begin 348 Item := TSqlDatabase.Create; 349 with TSqlDatabase(Item) do begin 350 HostName := Self.HostName; 351 UserName := Self.UserName; 352 Password := Self.Password; 353 Database := Self.Schema; 354 Connect; 355 end; 356 end; 357 end else 358 if FActive and not AValue then begin 359 360 end; 361 FActive := AValue; 370 362 end; 371 363 372 364 constructor TDatabasePool.Create; 373 365 begin 374 Lock := TCriticalSection.Create;366 inherited; 375 367 end; 376 368 377 369 destructor TDatabasePool.Destroy; 378 370 begin 379 Lock.Destroy;380 371 inherited Destroy; 381 372 end; -
branches/DirectWeb/WoWHostingWebServer.lpi
r88 r89 13 13 <Icon Value="0"/> 14 14 <UseXPManifest Value="True"/> 15 <ActiveEditorIndexAtStart Value=" 0"/>15 <ActiveEditorIndexAtStart Value="1"/> 16 16 </General> 17 17 <VersionInfo> … … 37 37 </Item1> 38 38 </RequiredPackages> 39 <Units Count="3 7">39 <Units Count="38"> 40 40 <Unit0> 41 41 <Filename Value="WoWHostingWebServer.lpr"/> 42 42 <IsPartOfProject Value="True"/> 43 43 <UnitName Value="WoWHostingWebServer"/> 44 <CursorPos X=" 32" Y="12"/>44 <CursorPos X="1" Y="24"/> 45 45 <TopLine Value="1"/> 46 46 <EditorIndex Value="0"/> … … 76 76 <IsPartOfProject Value="True"/> 77 77 <UnitName Value="UHTTPServer"/> 78 <CursorPos X=" 80" Y="119"/>79 <TopLine Value=" 102"/>80 <EditorIndex Value="1 1"/>78 <CursorPos X="17" Y="92"/> 79 <TopLine Value="74"/> 80 <EditorIndex Value="13"/> 81 81 <UsageCount Value="200"/> 82 82 <Loaded Value="True"/> … … 86 86 <CursorPos X="14" Y="1436"/> 87 87 <TopLine Value="1419"/> 88 <EditorIndex Value=" 8"/>89 <UsageCount Value="9 6"/>88 <EditorIndex Value="10"/> 89 <UsageCount Value="98"/> 90 90 <Loaded Value="True"/> 91 91 </Unit6> … … 101 101 <IsPartOfProject Value="True"/> 102 102 <UnitName Value="UTCPServer"/> 103 <CursorPos X=" 5" Y="23"/>104 <TopLine Value=" 6"/>103 <CursorPos X="24" Y="148"/> 104 <TopLine Value="130"/> 105 105 <EditorIndex Value="3"/> 106 106 <UsageCount Value="200"/> … … 128 128 <CursorPos X="24" Y="61"/> 129 129 <TopLine Value="1"/> 130 <UsageCount Value="13 0"/>130 <UsageCount Value="135"/> 131 131 </Unit11> 132 132 <Unit12> … … 148 148 <CursorPos X="3" Y="130"/> 149 149 <TopLine Value="121"/> 150 <UsageCount Value="1 29"/>150 <UsageCount Value="134"/> 151 151 </Unit14> 152 152 <Unit15> … … 156 156 <CursorPos X="26" Y="28"/> 157 157 <TopLine Value="25"/> 158 <UsageCount Value="1 29"/>158 <UsageCount Value="134"/> 159 159 </Unit15> 160 160 <Unit16> … … 162 162 <IsPartOfProject Value="True"/> 163 163 <UnitName Value="USqlDatabase"/> 164 <CursorPos X="3" Y="316"/> 165 <TopLine Value="314"/> 166 <UsageCount Value="76"/> 164 <CursorPos X="20" Y="178"/> 165 <TopLine Value="164"/> 166 <EditorIndex Value="8"/> 167 <UsageCount Value="81"/> 168 <Loaded Value="True"/> 167 169 </Unit16> 168 170 <Unit17> … … 182 184 <CursorPos X="3" Y="113"/> 183 185 <TopLine Value="97"/> 184 <EditorIndex Value=" 9"/>185 <UsageCount Value="3 0"/>186 <EditorIndex Value="11"/> 187 <UsageCount Value="32"/> 186 188 <Loaded Value="True"/> 187 189 </Unit19> … … 197 199 <IsPartOfProject Value="True"/> 198 200 <UnitName Value="UWebServer"/> 199 <CursorPos X="1 2" Y="10"/>200 <TopLine Value=" 12"/>201 <CursorPos X="15" Y="283"/> 202 <TopLine Value="260"/> 201 203 <EditorIndex Value="1"/> 202 <UsageCount Value="1 19"/>204 <UsageCount Value="124"/> 203 205 <Loaded Value="True"/> 204 206 </Unit21> … … 215 217 <CursorPos X="32" Y="11"/> 216 218 <TopLine Value="1"/> 217 <UsageCount Value=" 77"/>219 <UsageCount Value="82"/> 218 220 <SyntaxHighlighter Value="XML"/> 219 221 </Unit23> … … 223 225 <CursorPos X="77" Y="4"/> 224 226 <TopLine Value="1"/> 225 <UsageCount Value=" 77"/>227 <UsageCount Value="82"/> 226 228 <SyntaxHighlighter Value="None"/> 227 229 </Unit24> … … 239 241 <CursorPos X="35" Y="8"/> 240 242 <TopLine Value="1"/> 241 <EditorIndex Value="1 2"/>242 <UsageCount Value="7 4"/>243 <EditorIndex Value="14"/> 244 <UsageCount Value="79"/> 243 245 <Loaded Value="True"/> 244 246 </Unit26> … … 250 252 <TopLine Value="33"/> 251 253 <EditorIndex Value="2"/> 252 <UsageCount Value="7 2"/>254 <UsageCount Value="77"/> 253 255 <Loaded Value="True"/> 254 256 </Unit27> 255 257 <Unit28> 256 258 <Filename Value="..\..\..\..\..\Programy\Lazarus_0.9.29\fpc\2.3.1\source\rtl\inc\threadh.inc"/> 257 <CursorPos X=" 11" Y="154"/>258 <TopLine Value=" 130"/>259 <CursorPos X="26" Y="23"/> 260 <TopLine Value="4"/> 259 261 <EditorIndex Value="5"/> 260 <UsageCount Value="1 2"/>262 <UsageCount Value="14"/> 261 263 <Loaded Value="True"/> 262 264 </Unit28> … … 270 272 <Filename Value="..\..\..\..\..\Programy\Lazarus_0.9.29\fpc\2.3.1\source\packages\fcl-base\src\syncobjs.pp"/> 271 273 <UnitName Value="syncobjs"/> 272 <CursorPos X=" 4" Y="60"/>273 <TopLine Value=" 43"/>274 <CursorPos X="25" Y="138"/> 275 <TopLine Value="134"/> 274 276 <EditorIndex Value="4"/> 275 <UsageCount Value="3 0"/>277 <UsageCount Value="32"/> 276 278 <Loaded Value="True"/> 277 279 </Unit30> … … 299 301 <CursorPos X="26" Y="72"/> 300 302 <TopLine Value="64"/> 301 <EditorIndex Value=" 7"/>302 <UsageCount Value="3 0"/>303 <EditorIndex Value="9"/> 304 <UsageCount Value="32"/> 303 305 <Loaded Value="True"/> 304 306 </Unit34> … … 307 309 <IsPartOfProject Value="True"/> 308 310 <UnitName Value="UPool"/> 309 <CursorPos X="3 " Y="86"/>310 <TopLine Value="8 2"/>311 <EditorIndex Value=" 6"/>312 <UsageCount Value="6 0"/>311 <CursorPos X="37" Y="106"/> 312 <TopLine Value="88"/> 313 <EditorIndex Value="7"/> 314 <UsageCount Value="65"/> 313 315 <Loaded Value="True"/> 314 316 </Unit35> … … 317 319 <IsPartOfProject Value="True"/> 318 320 <UnitName Value="UResetableThread"/> 319 <CursorPos X=" 3" Y="22"/>320 <TopLine Value=" 5"/>321 <EditorIndex Value="1 0"/>322 <UsageCount Value=" 59"/>321 <CursorPos X="50" Y="72"/> 322 <TopLine Value="69"/> 323 <EditorIndex Value="12"/> 324 <UsageCount Value="64"/> 323 325 <Loaded Value="True"/> 324 326 </Unit36> 327 <Unit37> 328 <Filename Value="..\..\..\..\..\Programy\Lazarus_0.9.29\fpc\2.3.1\source\rtl\inc\thread.inc"/> 329 <CursorPos X="32" Y="236"/> 330 <TopLine Value="233"/> 331 <EditorIndex Value="6"/> 332 <UsageCount Value="11"/> 333 <Loaded Value="True"/> 334 </Unit37> 325 335 </Units> 326 336 <JumpHistory Count="30" HistoryIndex="29"> 327 337 <Position1> 328 <Filename Value="U TCPServer.pas"/>329 <Caret Line=" 57" Column="24" TopLine="34"/>338 <Filename Value="UWebServer.pas"/> 339 <Caret Line="130" Column="1" TopLine="113"/> 330 340 </Position1> 331 341 <Position2> 332 <Filename Value="U TCPServer.pas"/>333 <Caret Line=" 32" Column="38" TopLine="15"/>342 <Filename Value="UWebServer.pas"/> 343 <Caret Line="132" Column="1" TopLine="115"/> 334 344 </Position2> 335 345 <Position3> 336 <Filename Value="U Pool.pas"/>337 <Caret Line=" 33" Column="24" TopLine="6"/>346 <Filename Value="UWebServer.pas"/> 347 <Caret Line="134" Column="1" TopLine="117"/> 338 348 </Position3> 339 349 <Position4> 340 <Filename Value="U TCPServer.pas"/>341 <Caret Line=" 32" Column="39" TopLine="15"/>350 <Filename Value="UWebServer.pas"/> 351 <Caret Line="137" Column="1" TopLine="120"/> 342 352 </Position4> 343 353 <Position5> 344 <Filename Value="U TCPServer.pas"/>345 <Caret Line=" 58" Column="24" TopLine="39"/>354 <Filename Value="UWebServer.pas"/> 355 <Caret Line="128" Column="1" TopLine="111"/> 346 356 </Position5> 347 357 <Position6> 348 <Filename Value="U TCPServer.pas"/>349 <Caret Line=" 57" Column="30" TopLine="34"/>358 <Filename Value="UWebServer.pas"/> 359 <Caret Line="129" Column="1" TopLine="112"/> 350 360 </Position6> 351 361 <Position7> 352 <Filename Value="U TCPServer.pas"/>353 <Caret Line=" 218" Column="24" TopLine="195"/>362 <Filename Value="UWebServer.pas"/> 363 <Caret Line="130" Column="1" TopLine="113"/> 354 364 </Position7> 355 365 <Position8> 356 <Filename Value="U TCPServer.pas"/>357 <Caret Line="1 33" Column="65" TopLine="116"/>366 <Filename Value="UWebServer.pas"/> 367 <Caret Line="128" Column="1" TopLine="111"/> 358 368 </Position8> 359 369 <Position9> 360 <Filename Value="U TCPServer.pas"/>361 <Caret Line="1 35" Column="22" TopLine="118"/>370 <Filename Value="UWebServer.pas"/> 371 <Caret Line="129" Column="1" TopLine="112"/> 362 372 </Position9> 363 373 <Position10> 364 <Filename Value="U TCPServer.pas"/>365 <Caret Line="1 93" Column="8" TopLine="190"/>374 <Filename Value="UWebServer.pas"/> 375 <Caret Line="130" Column="1" TopLine="113"/> 366 376 </Position10> 367 377 <Position11> 368 <Filename Value="U TCPServer.pas"/>369 <Caret Line="13 4" Column="25" TopLine="117"/>378 <Filename Value="UWebServer.pas"/> 379 <Caret Line="132" Column="1" TopLine="115"/> 370 380 </Position11> 371 381 <Position12> 372 <Filename Value="U TCPServer.pas"/>373 <Caret Line=" 25" Column="17" TopLine="8"/>382 <Filename Value="UWebServer.pas"/> 383 <Caret Line="134" Column="1" TopLine="117"/> 374 384 </Position12> 375 385 <Position13> 376 <Filename Value="U TCPServer.pas"/>377 <Caret Line="13 4" Column="32" TopLine="117"/>386 <Filename Value="UWebServer.pas"/> 387 <Caret Line="137" Column="1" TopLine="120"/> 378 388 </Position13> 379 389 <Position14> 380 <Filename Value="U TCPServer.pas"/>381 <Caret Line="1 43" Column="1" TopLine="126"/>390 <Filename Value="USqlDatabase.pas"/> 391 <Caret Line="174" Column="1" TopLine="157"/> 382 392 </Position14> 383 393 <Position15> 384 <Filename Value="U TCPServer.pas"/>385 <Caret Line="1 41" Column="1" TopLine="126"/>394 <Filename Value="USqlDatabase.pas"/> 395 <Caret Line="176" Column="1" TopLine="159"/> 386 396 </Position15> 387 397 <Position16> 388 <Filename Value="U TCPServer.pas"/>389 <Caret Line="1 35" Column="36" TopLine="119"/>398 <Filename Value="USqlDatabase.pas"/> 399 <Caret Line="177" Column="1" TopLine="160"/> 390 400 </Position16> 391 401 <Position17> 392 <Filename Value="U TCPServer.pas"/>393 <Caret Line=" 23" Column="13" TopLine="8"/>402 <Filename Value="USqlDatabase.pas"/> 403 <Caret Line="179" Column="1" TopLine="162"/> 394 404 </Position17> 395 405 <Position18> 396 <Filename Value="U TCPServer.pas"/>397 <Caret Line="1 48" Column="5" TopLine="130"/>406 <Filename Value="USqlDatabase.pas"/> 407 <Caret Line="181" Column="25" TopLine="164"/> 398 408 </Position18> 399 409 <Position19> 400 <Filename Value="U TCPServer.pas"/>401 <Caret Line="1 54" Column="12" TopLine="137"/>410 <Filename Value="UWebServer.pas"/> 411 <Caret Line="128" Column="1" TopLine="111"/> 402 412 </Position19> 403 413 <Position20> 404 <Filename Value="U TCPServer.pas"/>405 <Caret Line=" 22" Column="31" TopLine="9"/>414 <Filename Value="UWebServer.pas"/> 415 <Caret Line="129" Column="1" TopLine="112"/> 406 416 </Position20> 407 417 <Position21> 408 <Filename Value="U TCPServer.pas"/>409 <Caret Line=" 26" Column="24" TopLine="9"/>418 <Filename Value="UWebServer.pas"/> 419 <Caret Line="130" Column="1" TopLine="113"/> 410 420 </Position21> 411 421 <Position22> 412 <Filename Value="U TCPServer.pas"/>413 <Caret Line="1 53" Column="36" TopLine="133"/>422 <Filename Value="UWebServer.pas"/> 423 <Caret Line="132" Column="1" TopLine="115"/> 414 424 </Position22> 415 425 <Position23> 416 <Filename Value="U TCPServer.pas"/>417 <Caret Line="1 71" Column="25" TopLine="148"/>426 <Filename Value="UWebServer.pas"/> 427 <Caret Line="134" Column="1" TopLine="117"/> 418 428 </Position23> 419 429 <Position24> 420 <Filename Value="U HTTPServer.pas"/>421 <Caret Line=" 35" Column="28" TopLine="35"/>430 <Filename Value="UWebServer.pas"/> 431 <Caret Line="137" Column="1" TopLine="120"/> 422 432 </Position24> 423 433 <Position25> 424 <Filename Value="U HTTPServer.pas"/>425 <Caret Line="1 80" Column="23" TopLine="162"/>434 <Filename Value="USqlDatabase.pas"/> 435 <Caret Line="174" Column="1" TopLine="157"/> 426 436 </Position25> 427 437 <Position26> 428 <Filename Value="U HTTPServer.pas"/>429 <Caret Line="1 19" Column="37" TopLine="102"/>438 <Filename Value="USqlDatabase.pas"/> 439 <Caret Line="176" Column="1" TopLine="159"/> 430 440 </Position26> 431 441 <Position27> 432 <Filename Value=" WoWHostingWebServer.lpr"/>433 <Caret Line="1 5" Column="26" TopLine="1"/>442 <Filename Value="USqlDatabase.pas"/> 443 <Caret Line="177" Column="1" TopLine="160"/> 434 444 </Position27> 435 445 <Position28> 436 <Filename Value=" WoWHostingWebServer.lpr"/>437 <Caret Line=" 25" Column="1" TopLine="1"/>446 <Filename Value="USqlDatabase.pas"/> 447 <Caret Line="179" Column="1" TopLine="162"/> 438 448 </Position28> 439 449 <Position29> 440 <Filename Value=" WoWHostingWebServer.lpr"/>441 <Caret Line="1 8" Column="24" TopLine="1"/>450 <Filename Value="UWebServer.pas"/> 451 <Caret Line="193" Column="1" TopLine="169"/> 442 452 </Position29> 443 453 <Position30> 444 <Filename Value=" WoWHostingWebServer.lpr"/>445 <Caret Line=" 21" Column="18" TopLine="1"/>454 <Filename Value="USqlDatabase.pas"/> 455 <Caret Line="178" Column="20" TopLine="164"/> 446 456 </Position30> 447 457 </JumpHistory> … … 455 465 <SearchPaths> 456 466 <IncludeFiles Value="$(ProjOutDir)\"/> 457 <UnitOutputDirectory Value=" lib\$(TargetCPU)-$(TargetOS)"/>467 <UnitOutputDirectory Value="bin\$(TargetCPU)-$(TargetOS)"/> 458 468 </SearchPaths> 459 469 <Other>
Note:
See TracChangeset
for help on using the changeset viewer.