Changeset 238
- Timestamp:
- Apr 30, 2011, 11:49:00 PM (14 years ago)
- Location:
- Network/CoolWeb
- Files:
-
- 4 edited
Legend:
- Unmodified
- Added
- Removed
-
Network/CoolWeb/CoolWeb.lpk
r237 r238 19 19 <Description Value="Unit set for generating CGI or server web application."/> 20 20 <License Value="GNU/GPL"/> 21 <Version Minor=" 1"/>21 <Version Minor="2"/> 22 22 <Files Count="17"> 23 23 <Item1> … … 47 47 <Item6> 48 48 <Filename Value="Persistence/USqlDatabase.pas"/> 49 <HasRegisterProc Value="True"/> 49 50 <UnitName Value="USqlDatabase"/> 50 51 </Item6> -
Network/CoolWeb/CoolWeb.pas
r237 r238 21 21 RegisterUnit('UHTTPSessionFile', @UHTTPSessionFile.Register); 22 22 RegisterUnit('UHTTPSessionMySQL', @UHTTPSessionMySQL.Register); 23 RegisterUnit('USqlDatabase', @USqlDatabase.Register); 23 24 end; 24 25 -
Network/CoolWeb/Persistence/USqlDatabase.pas
r104 r238 30 30 end; 31 31 32 TSqlDatabase = class 33 procedure mySQLClient1ConnectError(Sender: TObject; Msg: String); 32 { TSqlDatabase } 33 34 TSqlDatabase = class(TComponent) 34 35 private 36 FEncoding: string; 37 FHostName: string; 38 FPassword: string; 35 39 FSession: PMYSQL; 36 40 FConnected: Boolean; 37 41 FDatabase: string; 42 FUserName: string; 43 procedure mySQLClient1ConnectError(Sender: TObject; Msg: String); 38 44 function GetConnected: Boolean; 39 45 function GetLastErrorMessage: string; 40 46 function GetLastErrorNumber: Integer; 41 47 function GetCharset: string; 48 procedure SetConnected(const AValue: Boolean); 42 49 procedure SetDatabase(const Value: string); 43 50 public 44 Hostname: string; 45 UserName: string; 46 Password: string; 47 Encoding: string; 48 Table: string; 49 RepeatLastAction: Boolean; 51 LastUsedTable: string; 50 52 LastQuery: string; 51 53 procedure CreateDatabase; … … 63 65 property LastErrorMessage: string read GetLastErrorMessage; 64 66 property LastErrorNumber: Integer read GetLastErrorNumber; 65 property Connected: Boolean read GetConnected; 66 constructor Create; 67 constructor Create(AOwner: TComponent); override; 67 68 destructor Destroy; override; 68 69 property Charset: string read GetCharset; 70 published 71 property Connected: Boolean read GetConnected write SetConnected; 69 72 property Database: string read FDatabase write SetDatabase; 73 property HostName: string read FHostName write FHostName; 74 property UserName: string read FUserName write FUserName; 75 property Password: string read FPassword write FPassword; 76 property Encoding: string read FEncoding write FEncoding; 70 77 end; 71 78 … … 74 81 function SQLToDateTime(Value: string): TDateTime; 75 82 function DateTimeToSQL(Value: TDateTime): string; 83 84 procedure Register; 85 76 86 77 87 implementation … … 98 108 CLIENT_TRANSACTIONS = 8192; // Client knows about transactions 99 109 110 procedure Register; 111 begin 112 RegisterComponents('CoolWeb', [TSqlDatabase]); 113 end; 114 100 115 function MySQLFloatToStr(F: Real): string; 101 116 var … … 157 172 Rows: TDbRows; 158 173 begin 159 RepeatLastAction := False;160 174 // mySQLClient1.Connect; 161 175 FSession := mysql_init(FSession); … … 187 201 DbResult: TDbRows; 188 202 begin 189 Table := ATable;203 LastUsedTable := ATable; 190 204 DbNames := ''; 191 205 DbValues := ''; … … 201 215 try 202 216 DbResult := TDbRows.Create; 203 Query(DbResult, 'INSERT INTO `' + Table + '` (' + DbNames + ') VALUES (' + DbValues + ')');217 Query(DbResult, 'INSERT INTO `' + ATable + '` (' + DbNames + ') VALUES (' + DbValues + ')'); 204 218 finally 205 219 DbResult.Free; … … 215 229 DbRows.Clear; 216 230 //DebugLog('SqlDatabase query: '+Data); 217 RepeatLastAction := False;218 231 LastQuery := Data; 219 232 mysql_query(FSession, PChar(Data)); … … 247 260 DbResult: TDbRows; 248 261 begin 249 Table := ATable;262 LastUsedTable := ATable; 250 263 DbNames := ''; 251 264 DbValues := ''; … … 261 274 try 262 275 DbResult := TDbRows.Create; 263 Query(DbResult, 'REPLACE INTO `' + Table + '` (' + DbNames + ') VALUES (' + DbValues + ')');276 Query(DbResult, 'REPLACE INTO `' + ATable + '` (' + DbNames + ') VALUES (' + DbValues + ')'); 264 277 finally 265 278 DbResult.Free; … … 269 282 procedure TSqlDatabase.Select(DbRows: TDbRows; ATable: string; Filter: string = '*'; Condition: string = '1'); 270 283 begin 271 Table := ATable;272 Query(DbRows, 'SELECT ' + Filter + ' FROM `' + Table + '` WHERE ' + Condition);284 LastUsedTable := ATable; 285 Query(DbRows, 'SELECT ' + Filter + ' FROM `' + ATable + '` WHERE ' + Condition); 273 286 end; 274 287 … … 280 293 DbResult: TDbRows; 281 294 begin 282 Table := ATable;295 LastUsedTable := ATable; 283 296 DbValues := ''; 284 297 for I := 0 to Data.Count - 1 do begin … … 291 304 try 292 305 DbResult := TDbRows.Create; 293 Query(DbResult, 'UPDATE `' + Table + '` SET (' + DbValues + ') WHERE ' + Condition);306 Query(DbResult, 'UPDATE `' + ATable + '` SET (' + DbValues + ') WHERE ' + Condition); 294 307 finally 295 308 DbResult.Free; … … 306 319 DbResult: TDbRows; 307 320 begin 308 Table := ATable;321 LastUsedTable := ATable; 309 322 try 310 323 DbResult := TDbRows.Create; 311 Query(DbResult, 'DELETE FROM `' + Table + '` WHERE ' + Condition);324 Query(DbResult, 'DELETE FROM `' + ATable + '` WHERE ' + Condition); 312 325 finally 313 326 DbResult.Free; … … 326 339 end; 327 340 328 constructor TSqlDatabase.Create ;341 constructor TSqlDatabase.Create(AOwner: TComponent); 329 342 begin 330 343 inherited; … … 406 419 end; 407 420 421 procedure TSqlDatabase.SetConnected(const AValue: Boolean); 422 begin 423 if AValue = FConnected then Exit; 424 if AValue then Connect 425 else Disconnect; 426 end; 427 408 428 procedure TSqlDatabase.SetDatabase(const Value: string); 409 429 begin -
Network/CoolWeb/WebServer/UHTTPSessionMySQL.pas
r237 r238 17 17 private 18 18 FSessionIdCookieName: string; 19 FDatabase: TSqlDatabase; 19 20 FTimeout: Integer; 20 21 Lock: TCriticalSection; … … 22 23 procedure GetSessionId(HandlerData: THTTPHandlerData); 23 24 public 24 SqlDatabase: TSqlDatabase;25 25 Sessions: TStringList; 26 26 procedure Load(HandlerData: THTTPHandlerData); override; … … 29 29 destructor Destroy; override; 30 30 published 31 property Database: TSqlDatabase read FDatabase write FDatabase; 31 32 property Timeout: Integer read FTimeout write FTimeout; // in seconds 32 33 property SessionIdCookieName: string read FSessionIdCookieName … … 55 56 try 56 57 DbRows := TDbRows.Create; 57 SqlDatabase.Query(DbRows, 'SELECT * FROM `HTTPSession` WHERE `Identification`="' +58 Database.Query(DbRows, 'SELECT * FROM `HTTPSession` WHERE `Identification`="' + 58 59 Result + '"'); 59 60 Found := DbRows.Count > 0; … … 83 84 Lock.Acquire; 84 85 DbRows := TDbRows.Create; 85 SqlDatabase.Query(DbRows, 'DELETE FROM `HTTPSession` WHERE `Time` < DATE_SUB(NOW(), INTERVAL ' +86 Database.Query(DbRows, 'DELETE FROM `HTTPSession` WHERE `Time` < DATE_SUB(NOW(), INTERVAL ' + 86 87 IntToStr(Timeout) +' SECOND)'); 87 SqlDatabase.Query(DbRows, 'SELECT * FROM `HTTPSession` WHERE `Identification`="' +88 Database.Query(DbRows, 'SELECT * FROM `HTTPSession` WHERE `Identification`="' + 88 89 HandlerData.SessionId + '"'); 89 90 if DbRows.Count > 0 then begin … … 108 109 DbRows := TDbRows.Create; 109 110 DbRows2 := TDbRows.Create; 110 SqlDatabase.Query(DbRows, 'SELECT * FROM `HTTPSession` WHERE `Identification`="' +111 Database.Query(DbRows, 'SELECT * FROM `HTTPSession` WHERE `Identification`="' + 111 112 HandlerData.SessionId + '"'); 112 113 if DbRows.Count > 0 then 113 SqlDatabase.Query(DbRows2, 'UPDATE `HTTPSession` SET `Variables`="' + HandlerData.Session.Text114 Database.Query(DbRows2, 'UPDATE `HTTPSession` SET `Variables`="' + HandlerData.Session.Text 114 115 + '", `Time` = NOW() WHERE `Identification`="' + HandlerData.SessionId + '"') 115 else SqlDatabase.Query(DbRows2, 'INSERT INTO `HTTPSession` (`Time`, `Variables`, `Identification`) VALUES (' +116 else Database.Query(DbRows2, 'INSERT INTO `HTTPSession` (`Time`, `Variables`, `Identification`) VALUES (' + 116 117 'NOW(), "' + HandlerData.Session.Text + '", "' + HandlerData.SessionId + '")'); 117 118 HandlerData.Response.Cookies.Values[SessionIdCookieName] := HandlerData.SessionId;
Note:
See TracChangeset
for help on using the changeset viewer.