- Timestamp:
- Mar 17, 2015, 12:09:11 AM (10 years ago)
- Location:
- trunk
- Files:
-
- 54 added
- 1 deleted
- 14 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/DbEngines/UEngineMySQL.pas
r12 r13 14 14 TDatabaseMySQL = class(TDatabaseClient) 15 15 private 16 procedure LoadFields(Table: TTable); 16 17 procedure LoadTables; 17 18 public 18 19 SqlDatabase: TSqlDatabase; 20 procedure Query(DbRows: TDbRows; Text: string); override; 19 21 constructor Create; override; 20 22 destructor Destroy; override; … … 27 29 { TDatabaseMySQL } 28 30 31 procedure TDatabaseMySQL.LoadFields(Table: TTable); 32 var 33 DbRows: TDbRows; 34 NewField: TField; 35 I: Integer; 36 DataType: Integer; 37 begin 38 DbRows := TDbRows.Create; 39 try 40 SqlDatabase.Query(DbRows, 'SELECT * FROM `ModelField` WHERE `Model` = ' + IntToStr(Table.Id) + ''); 41 for I := 0 to DbRows.Count - 1 do begin 42 NewField := TField.Create; 43 NewField.Table := Table; 44 NewField.Name := TDictionaryStringString(DbRows[I]).Values['Name']; 45 NewField.TextBefore := TDictionaryStringString(DbRows[I]).Values['Title']; 46 DataType := StrToInt(TDictionaryStringString(DbRows[I]).Values['DataType']); 47 NewField.DataType := Table.Database.Engine.DataTypes.FindByType(TFieldType(DataType)); 48 if not Assigned(NewField.DataType) then 49 NewField.DataType := Table.Database.Engine.DataTypes.FindByType(ftString); 50 Table.Fields.Add(NewField); 51 end; 52 finally 53 DbRows.Free; 54 end; 55 end; 56 29 57 procedure TDatabaseMySQL.LoadTables; 30 58 var 31 59 DbRows: TDbRows; 60 DbRows2: TDbRows; 32 61 NewTable: TTable; 33 62 I: Integer; … … 35 64 DbRows := TDbRows.Create; 36 65 try 37 SqlDatabase.Query(DbRows, 'SELECT ` TABLE_NAME` FROM `information_schema`.`TABLES` WHERE `TABLE_SCHEMA` = "' + SqlDatabase.Database + '"');66 SqlDatabase.Query(DbRows, 'SELECT `Id`,`Name`,`Title` FROM `Model`'); 38 67 for I := 0 to DbRows.Count - 1 do begin 39 68 NewTable := TTable.Create; 69 NewTable.Id := StrToInt(TDictionaryStringString(DbRows[I]).Values['Id']); 40 70 NewTable.Database := Database; 41 NewTable.Name := (TDictionaryStringString(DbRows[I])[0]).Value; 42 NewTable.Caption := NewTable.Name; 71 NewTable.Name := TDictionaryStringString(DbRows[I]).Values['Name']; 72 NewTable.Caption := TDictionaryStringString(DbRows[I]).Values['Title']; 73 LoadFields(NewTable); 74 DbRows2 := TDbRows.Create; 75 try 76 SqlDatabase.Query(DbRows2, 'SELECT COUNT(*) FROM `' + NewTable.Name + '`'); 77 if DbRows2.Count = 1 then 78 NewTable.RecordsCount := StrToInt(DbRows2[0].Values['COUNT(*)']); 79 finally 80 DbRows2.Free; 81 end; 43 82 Database.Tables.Add(NewTable); 44 83 end; … … 46 85 DbRows.Free; 47 86 end; 87 end; 88 89 procedure TDatabaseMySQL.Query(DbRows: TDbRows; Text: string); 90 begin 91 SqlDatabase.Query(DbRows, Text); 48 92 end; 49 93 -
trunk/DbEngines/UEngineXML.pas
r12 r13 7 7 uses 8 8 Classes, SysUtils, DOM, XMLRead, XMLWrite, UDatabase, UXMLUtils, FileUtil, 9 UHtmlClasses ;9 UHtmlClasses, USqlDatabase, SpecializedDictionary; 10 10 11 11 type … … 29 29 procedure LoadFromFile(FileName: string); 30 30 procedure SaveToFile(FileName: string); 31 function GetNextPart(var Text: string): string; 31 32 public 33 procedure Query(DbRows: TDbRows; Text: string); override; 32 34 procedure Load; override; 33 35 procedure Save; override; … … 280 282 end; 281 283 284 function TDatabaseXML.GetNextPart(var Text: string): string; 285 begin 286 if Pos(' ', Text) > 0 then begin 287 Result := Trim(Copy(Text, 1, Pos(' ', Text) - 1)); 288 Delete(Text, 1, Pos(' ', Text)); 289 end else begin 290 Result := Text; 291 Text := ''; 292 end; 293 end; 294 295 procedure TDatabaseXML.Query(DbRows: TDbRows; Text: string); 296 var 297 Command: string; 298 Columns: string; 299 TableName: string; 300 Table: TTable; 301 NewRecord: TDictionaryStringString; 302 I: Integer; 303 F: Integer; 304 begin 305 Command := GetNextPart(Text); 306 if Command = 'SELECT' then begin 307 Columns := GetNextPart(Text); 308 Command := GetNextPart(Text); 309 if Command = 'FROM' then begin 310 TableName := GetNextPart(Text); 311 end; 312 Table := Database.Tables.SearchByName(TableName); 313 if Assigned(Table) then begin 314 DbRows.Count := 0; 315 if Columns = '*' then begin 316 for I := 0 to Table.Records.Count - 1 do begin 317 NewRecord := TDictionaryStringString.Create; 318 for F := 0 to Table.Fields.Count - 1 do 319 NewRecord.Add(TField(Table.Fields[F]).Name, TValue(TRecord(Table.Records[I]).Values[I]).GetString); 320 DbRows.Add(NewRecord); 321 end; 322 end else 323 if Columns = 'COUNT(*)' then begin 324 NewRecord := TDictionaryStringString.Create; 325 NewRecord.Add('COUNT(*)', IntToStr(Table.Records.Count)); 326 DbRows.Add(NewRecord); 327 end else raise Exception.Create('Unsupported columns ' + Columns + ' specification'); 328 end else raise Exception.Create('Table ' + TableName + ' not found.'); 329 end else raise Exception.Create('Unsupported SQL command ' + Command); 330 end; 331 282 332 procedure TDatabaseXML.Load; 283 333 begin -
trunk/Forms/UFormRecord.lfm
r8 r13 1 1 object FormRecord: TFormRecord 2 2 Left = 639 3 Height = 6 944 Top = 1745 Width = 85 93 Height = 649 4 Top = 223 5 Width = 858 6 6 Caption = 'FormRecord' 7 ClientHeight = 6 948 ClientWidth = 85 97 ClientHeight = 649 8 ClientWidth = 858 9 9 OnCreate = FormCreate 10 10 OnDestroy = FormDestroy … … 14 14 object Panel1: TPanel 15 15 Left = 4 16 Height = 63216 Height = 583 17 17 Top = 4 18 Width = 85 118 Width = 850 19 19 Align = alTop 20 Anchors = [akTop, akLeft, akRight, akBottom] 20 21 BorderSpacing.Around = 4 21 22 BevelOuter = bvNone … … 23 24 end 24 25 object ButtonOk: TButton 25 Left = 7 6026 Left = 759 26 27 Height = 25 27 Top = 6 4828 Top = 603 28 29 Width = 75 29 30 Anchors = [akRight, akBottom] … … 33 34 end 34 35 object ButtonCancel: TButton 35 Left = 64 936 Left = 648 36 37 Height = 27 37 Top = 6 4638 Top = 601 38 39 Width = 72 39 40 Anchors = [akRight, akBottom] -
trunk/Forms/UFormRecords.lfm
r11 r13 1 1 object FormRecords: TFormRecords 2 2 Left = 621 3 Height = 4334 Top = 4245 Width = 8 593 Height = 549 4 Top = 308 5 Width = 897 6 6 Caption = 'Records' 7 ClientHeight = 4338 ClientWidth = 8 597 ClientHeight = 549 8 ClientWidth = 897 9 9 OnShow = FormShow 10 10 Position = poMainFormCenter … … 12 12 object ListView1: TListView 13 13 Left = 4 14 Height = 38914 Height = 505 15 15 Top = 4 16 Width = 8 5116 Width = 889 17 17 Align = alClient 18 18 BorderSpacing.Around = 4 … … 39 39 Left = 0 40 40 Height = 36 41 Top = 39742 Width = 8 5941 Top = 513 42 Width = 897 43 43 Align = alBottom 44 44 ButtonHeight = 32 -
trunk/Forms/UFormRecords.pas
r11 r13 147 147 NewColumn: TListColumn; 148 148 begin 149 Table.LoadRecords; 149 150 ListView1.Columns.Clear; 150 151 for I := 0 to Table.Fields.Count - 1 do begin -
trunk/Forms/UFormTables.pas
r11 r13 77 77 with TTable(Database.Tables[Item.Index]) do begin 78 78 Item.Caption := Caption; 79 Item.SubItems.Add(IntToStr(Records .Count));79 Item.SubItems.Add(IntToStr(RecordsCount)); 80 80 Item.Data := Database.Tables[Item.Index]; 81 81 end … … 215 215 216 216 procedure TFormTables.ReloadList; 217 begin 217 var 218 I: Integer; 219 begin 220 for I := 0 to Database.Tables.Count - 1 do 221 TTable(Database.Tables[I]).LoadRecordsCount; 218 222 if Assigned(Database) then begin 219 223 ListView1.Items.Count := Database.Tables.Count; -
trunk/Languages/MyData.cs.po
r12 r13 241 241 242 242 #: tformpreferences.buttonsave.caption 243 msgctxt "tformpreferences.buttonsave.caption" 243 244 msgid "Save" 244 245 msgstr "Uložit" … … 257 258 msgstr "Jazyk:" 258 259 260 #: tformrecord.acancel.caption 261 msgctxt "tformrecord.acancel.caption" 262 msgid "Cancel" 263 msgstr "Zrušit" 264 265 #: tformrecord.asave.caption 266 msgctxt "tformrecord.asave.caption" 267 msgid "Save" 268 msgstr "Uložit" 269 270 #: tformrecord.buttoncancel.caption 271 msgctxt "tformrecord.buttoncancel.caption" 272 msgid "Cancel" 273 msgstr "Zrušit" 274 275 #: tformrecord.buttonok.caption 276 msgctxt "tformrecord.buttonok.caption" 277 msgid "Ok" 278 msgstr "Ok" 279 280 #: tformrecord.caption 281 msgid "FormRecord" 282 msgstr "" 283 259 284 #: tformrecords.aadd.caption 260 285 msgctxt "tformrecords.aadd.caption" … … 403 428 #: usqldatabase.sdatabasequeryerror 404 429 msgid "Database query error: \"%s\"" 405 msgstr "" 406 430 msgstr "Chyba požadavku databáze: \"%s\"" -
trunk/Languages/MyData.po
r12 r13 232 232 233 233 #: tformpreferences.buttonsave.caption 234 msgctxt "tformpreferences.buttonsave.caption" 234 235 msgid "Save" 235 236 msgstr "" … … 248 249 msgstr "" 249 250 251 #: tformrecord.acancel.caption 252 msgctxt "TFORMRECORD.ACANCEL.CAPTION" 253 msgid "Cancel" 254 msgstr "" 255 256 #: tformrecord.asave.caption 257 msgctxt "TFORMRECORD.ASAVE.CAPTION" 258 msgid "Save" 259 msgstr "" 260 261 #: tformrecord.buttoncancel.caption 262 msgctxt "TFORMRECORD.BUTTONCANCEL.CAPTION" 263 msgid "Cancel" 264 msgstr "" 265 266 #: tformrecord.buttonok.caption 267 msgctxt "TFORMRECORD.BUTTONOK.CAPTION" 268 msgid "Ok" 269 msgstr "" 270 271 #: tformrecord.caption 272 msgid "FormRecord" 273 msgstr "" 274 250 275 #: tformrecords.aadd.caption 251 276 msgctxt "tformrecords.aadd.caption" -
trunk/MyData.lpi
r12 r13 68 68 </local> 69 69 </RunParams> 70 <RequiredPackages Count=" 6">70 <RequiredPackages Count="8"> 71 71 <Item1> 72 <PackageName Value="synapse"/> 73 <DefaultFilename Value="Packages/synapse/synapse.lpk" Prefer="True"/> 74 </Item1> 75 <Item2> 76 <PackageName Value="Network"/> 77 <DefaultFilename Value="Packages/Network/Network.lpk" Prefer="True"/> 78 </Item2> 79 <Item3> 72 80 <PackageName Value="CoolWeb"/> 73 81 <DefaultFilename Value="Packages/CoolWeb/CoolWeb.lpk" Prefer="True"/> 74 </Item 1>75 <Item 2>82 </Item3> 83 <Item4> 76 84 <PackageName Value="TemplateGenerics"/> 77 85 <DefaultFilename Value="Packages/TemplateGenerics/TemplateGenerics.lpk" Prefer="True"/> 78 </Item 2>79 <Item 3>86 </Item4> 87 <Item5> 80 88 <PackageName Value="CoolTranslator"/> 81 89 <DefaultFilename Value="Packages/CoolTranslator/CoolTranslator.lpk" Prefer="True"/> 82 </Item 3>83 <Item 4>90 </Item5> 91 <Item6> 84 92 <PackageName Value="FCL"/> 85 </Item 4>86 <Item 5>93 </Item6> 94 <Item7> 87 95 <PackageName Value="Common"/> 88 96 <DefaultFilename Value="Packages/Common/Common.lpk" Prefer="True"/> 89 </Item 5>90 <Item 6>97 </Item7> 98 <Item8> 91 99 <PackageName Value="LCL"/> 92 </Item 6>100 </Item8> 93 101 </RequiredPackages> 94 102 <Units Count="17"> … … 129 137 <HasResources Value="True"/> 130 138 <ResourceBaseClass Value="Form"/> 131 <UnitName Value="UFormTable"/>132 139 </Unit5> 133 140 <Unit6> … … 153 160 <HasResources Value="True"/> 154 161 <ResourceBaseClass Value="Form"/> 155 <UnitName Value="UFormFields"/>156 162 </Unit8> 157 163 <Unit9> … … 161 167 <HasResources Value="True"/> 162 168 <ResourceBaseClass Value="Form"/> 163 <UnitName Value="UFormField"/>164 169 </Unit9> 165 170 <Unit10> … … 184 189 <HasResources Value="True"/> 185 190 <ResourceBaseClass Value="Form"/> 186 <UnitName Value="UFormMain"/>187 191 </Unit13> 188 192 <Unit14> … … 192 196 <HasResources Value="True"/> 193 197 <ResourceBaseClass Value="Form"/> 194 <UnitName Value="UFormConnect"/>195 198 </Unit14> 196 199 <Unit15> … … 208 211 <HasResources Value="True"/> 209 212 <ResourceBaseClass Value="Form"/> 210 <UnitName Value="UFormPreferences"/>211 213 </Unit16> 212 214 </Units> -
trunk/MyData.lpr
r12 r13 10 10 Forms, UFormTables, UDatabase, UCore, Common, CoolTranslator, UEngineXML, 11 11 UFormTable, UFormRecords, UFormRecord, UFormFields, UFormField, UDataTypes, 12 TemplateGenerics, CoolWeb, UEngineMySQL, UEngineSQLite, UFormMain,12 TemplateGenerics, CoolWeb, synapse, UEngineMySQL, UEngineSQLite, UFormMain, 13 13 UFormConnect, UFormDatabases, UFormPreferences; 14 14 -
trunk/Packages/CoolWeb/WebServer/UHTTPServerTCP.pas
r12 r13 144 144 inherited; 145 145 MaxConnection := 10000; 146 Socket := TTCPServer.Create ;146 Socket := TTCPServer.Create(nil); 147 147 Socket.OnClientConnect := HandleClient; 148 148 RequestHandlerList := TRequestHandlerList.Create; -
trunk/UCore.pas
r11 r13 140 140 DataTypes.Clear; 141 141 with DataTypes do begin 142 RegisterType( STypeString, ftString, TFieldString);143 RegisterType( STypeInteger, ftInteger, TFieldInteger);144 RegisterType( STypeDateTime, ftDateTime, TFieldDateTime);145 RegisterType( STypeBoolean, ftBoolean, TFieldBoolean);146 RegisterType( STypeFloat, ftFloat, TFieldFloat);147 RegisterType( STypeMapPosition, ftMapPosition, TFieldMapPosition);148 RegisterType( STypeDate, ftDate, TFieldDate);149 RegisterType( STypeTime, ftTime, TFieldTime);150 RegisterType( STypeImage, ftImage, TFieldImage);142 RegisterType(1, STypeString, ftString, TFieldString); 143 RegisterType(2, STypeInteger, ftInteger, TFieldInteger); 144 RegisterType(3, STypeDateTime, ftDateTime, TFieldDateTime); 145 RegisterType(4, STypeBoolean, ftBoolean, TFieldBoolean); 146 RegisterType(5, STypeFloat, ftFloat, TFieldFloat); 147 RegisterType(6, STypeMapPosition, ftMapPosition, TFieldMapPosition); 148 RegisterType(7, STypeDate, ftDate, TFieldDate); 149 RegisterType(8, STypeTime, ftTime, TFieldTime); 150 RegisterType(9, STypeImage, ftImage, TFieldImage); 151 151 end; 152 152 end; -
trunk/UDataTypes.pas
r8 r13 15 15 procedure Assign(Source: TValue); override; 16 16 function GetString: string; override; 17 function SetString(Value: string): string; override; 17 18 end; 18 19 … … 23 24 procedure Assign(Source: TValue); override; 24 25 function GetString: string; override; 26 function SetString(Value: string): string; override; 25 27 end; 26 28 … … 31 33 procedure Assign(Source: TValue); override; 32 34 function GetString: string; override; 35 function SetString(Value: string): string; override; 33 36 end; 34 37 … … 39 42 procedure Assign(Source: TValue); override; 40 43 function GetString: string; override; 44 function SetString(Value: string): string; override; 41 45 end; 42 46 … … 47 51 procedure Assign(Source: TValue); override; 48 52 function GetString: string; override; 53 function SetString(Value: string): string; override; 49 54 end; 50 55 … … 129 134 end; 130 135 136 function TValueFloat.SetString(Value: string): string; 137 begin 138 Self.Value := StrToFloat(Value); 139 end; 140 131 141 { TFieldBoolean } 132 142 … … 188 198 end; 189 199 200 function TValueBoolean.SetString(Value: string): string; 201 begin 202 Self.Value := StrToBool(Value); 203 end; 204 190 205 { TValueInteger } 191 206 … … 199 214 begin 200 215 Result := IntToStr(Value); 216 end; 217 218 function TValueInteger.SetString(Value: string): string; 219 begin 220 Self.Value := StrToInt(Value); 201 221 end; 202 222 … … 229 249 end; 230 250 251 function TValueDateTime.SetString(Value: string): string; 252 begin 253 Self.Value := StrToDateTime(Value); 254 end; 255 231 256 { TValueString } 232 257 … … 242 267 end; 243 268 269 function TValueString.SetString(Value: string): string; 270 begin 271 Self.Value := Value; 272 end; 273 244 274 { TFieldString } 245 275 -
trunk/UDatabase.pas
r12 r13 6 6 7 7 uses 8 Classes, SysUtils, Contnrs, ExtCtrls, StdCtrls, EditBtn, dialogs; 8 Classes, SysUtils, Contnrs, ExtCtrls, StdCtrls, EditBtn, dialogs, USqlDatabase, 9 SpecializedDictionary; 9 10 10 11 type … … 23 24 procedure Assign(Source: TValue); virtual; 24 25 function GetString: string; virtual; 26 function SetString(Value: string): string; virtual; 25 27 end; 26 28 … … 94 96 95 97 TTable = class 98 Id: Integer; 96 99 Name: string; 97 100 Caption: string; … … 99 102 Fields: TFields; 100 103 Database: TDatabase; 104 RecordsCount: Integer; 105 procedure LoadRecords; 106 procedure LoadRecordsCount; 101 107 procedure Assign(Source: TTable); 102 108 constructor Create; … … 104 110 end; 105 111 112 { TTables } 113 106 114 TTables = class(TObjectList) 107 115 Database: TDatabase; 116 function SearchByName(Name: string): TTable; 108 117 end; 109 118 … … 140 149 141 150 TDataType = class 151 Id: Integer; 142 152 Name: string; 143 153 FieldType: TFieldType; … … 148 158 149 159 TDataTypes = class(TObjectList) 150 function RegisterType( Name: string; FieldType: TFieldType; FieldTypeClass: TFieldTypeSpecificClass): TDataType;160 function RegisterType(Id: Integer; Name: string; FieldType: TFieldType; FieldTypeClass: TFieldTypeSpecificClass): TDataType; 151 161 function FindByType(FieldType: TFieldType): TDataType; 152 162 end; … … 156 166 TDatabaseClient = class 157 167 Database: TDatabase; 168 procedure Query(DbRows: TDbRows; Text: string); virtual; 158 169 constructor Create; virtual; 159 170 procedure Load; virtual; … … 194 205 UDataTypes; 195 206 207 { TTables } 208 209 function TTables.SearchByName(Name: string): TTable; 210 var 211 I: Integer; 212 begin 213 I := 0; 214 while (I < Count) and (TTable(Items[I]).Name <> Name) do Inc(I); 215 if I < Count then Result := TTable(Items[I]) 216 else Result := nil; 217 end; 218 196 219 { TDatabases } 197 220 … … 208 231 { TDatabaseClient } 209 232 233 procedure TDatabaseClient.Query(DbRows: TDbRows; Text: string); 234 begin 235 end; 236 210 237 constructor TDatabaseClient.Create; 211 238 begin … … 245 272 { TDataTypes } 246 273 247 function TDataTypes.RegisterType( Name: string; FieldType: TFieldType;274 function TDataTypes.RegisterType(Id: Integer; Name: string; FieldType: TFieldType; 248 275 FieldTypeClass: TFieldTypeSpecificClass): TDataType; 249 276 begin 250 277 Result := TDataType.Create; 278 Result.Id := Id; 251 279 Result.Name := Name; 252 280 Result.FieldType := FieldType; … … 380 408 end; 381 409 410 function TValue.SetString(Value: string): string; 411 begin 412 413 end; 414 382 415 { TFieldTypeSpecific } 383 416 … … 430 463 { TTable } 431 464 465 procedure TTable.LoadRecords; 466 var 467 DbRows: TDbRows; 468 I: Integer; 469 F: Integer; 470 NewRecord: TRecord; 471 NewValue: TValue; 472 begin 473 Records.Clear; 474 DbRows := TDbRows.Create; 475 Database.Client.Query(DbRows, 'SELECT * FROM ' + Name); 476 for I := 0 to DbRows.Count - 1 do begin 477 NewRecord := TRecord.Create; 478 for F := 0 to Fields.Count - 1 do begin 479 NewValue := TField(Fields[F]).GetValueClass.Create; 480 NewValue.SetString(TDictionaryStringString(DbRows[I]).Values[TField(Fields[F]).Name]); 481 NewRecord.Values.Add(NewValue); 482 end; 483 Records.Add(NewRecord); 484 end; 485 DbRows.Free; 486 end; 487 488 procedure TTable.LoadRecordsCount; 489 var 490 DbRows: TDbRows; 491 I: Integer; 492 F: Integer; 493 NewRecord: TRecord; 494 NewValue: TValue; 495 begin 496 Records.Clear; 497 DbRows := TDbRows.Create; 498 Database.Client.Query(DbRows, 'SELECT COUNT(*) FROM ' + Name); 499 if DbRows.Count = 1 then begin 500 RecordsCount := StrToInt(TDictionaryStringString(DbRows[0]).Items[0].Value); 501 end else RecordsCount := 0; 502 DbRows.Free; 503 end; 504 432 505 procedure TTable.Assign(Source: TTable); 433 506 begin
Note:
See TracChangeset
for help on using the changeset viewer.