source: trunk/DbEngines/UEngineXML.pas

Last change on this file was 29, checked in by chronos, 20 months ago
  • Fixed: Load table fields in records list and record edit form.
  • Fixed: Record add needs to insert new row into database.
File size: 22.8 KB
Line 
1unit UEngineXML;
2
3interface
4
5uses
6 Classes, SysUtils, DOM, XMLRead, XMLWrite, UDatabase, UXMLUtils, FileUtil,
7 UHtmlClasses, USqlDatabase, UGenerics;
8
9type
10 { TDatabaseXML }
11
12 TDatabaseXML = class(TDbClient)
13 private
14 FFileName: string;
15 Tables: TTables;
16 procedure LoadNodeRecord(Row: TRecord; Node: TDOMNode);
17 procedure SaveNodeRecord(Row: TRecord; Node: TDOMNode);
18 procedure LoadNodeRecords(Records: TRecords; Node: TDOMNode);
19 procedure SaveNodeRecords(Records: TRecords; Node: TDOMNode);
20 procedure LoadNodeField(Field: TField; Node: TDOMNode);
21 procedure SaveNodeField(Field: TField; Node: TDOMNode);
22 procedure LoadNodeFields(Fields: TFields; Node: TDOMNode);
23 procedure SaveNodeFields(Fields: TFields; Node: TDOMNode);
24 procedure LoadNodeTable(Table: TTable; Node: TDOMNode);
25 procedure SaveNodeTable(Table: TTable; Node: TDOMNode);
26 procedure LoadNodeTables(Tables: TTables; Node: TDOMNode);
27 procedure SaveNodeTables(Tables: TTables; Node: TDOMNode);
28 procedure LoadFromFile(FileName: string);
29 procedure SaveToFile(FileName: string);
30 procedure Expect(var Source: string; Text: string);
31 function CheckNext(var Source: string; Text: string): Boolean;
32 function GetNextPart(var Text: string; Separator: string = ' '): string;
33 procedure QuerySelect(Text: string; DbRows: TDbRows = nil);
34 procedure QueryInsert(Text: string; DbRows: TDbRows = nil);
35 procedure QueryDelete(Text: string; DbRows: TDbRows = nil);
36 procedure QueryUpdate(Text: string; DbRows: TDbRows = nil);
37 function TableCreateIfNotExists(Name: string): TTable;
38 function FieldCreateIfNotExists(TableName, FieldName: string; DataType: TDataType): TField;
39 public
40 procedure Query(Text: string; DbRows: TDbRows = nil); override;
41 procedure Load; override;
42 procedure Save; override;
43 constructor Create; override;
44 destructor Destroy; override;
45 property FileName: string read FFileName write FFileName;
46 end;
47
48 { TDbConnectParamsXml }
49
50 TDbConnectParamsXml = class(TDbConnectParams)
51 protected
52 function GetConnectionString: string; override;
53 procedure SetConnectionString(AValue: string); override;
54 public
55 FileName: string;
56 end;
57
58
59implementation
60
61uses
62 UDataTypes;
63
64resourcestring
65 SWrongFileFormat = 'Wrong file format';
66 STableNotFound = 'Table %s not found';
67 SFieldNotFound = 'Table field %s not found';
68 SUnsupportedSqlCommand = 'Unsupported SQL command: %s';
69 SColumnNotFoundInTable = 'Column %s not found in table %s';
70
71{ TDbConnectParamsXml }
72
73function TDbConnectParamsXml.GetConnectionString: string;
74begin
75 Result := 'file:///' + FileName;
76end;
77
78procedure TDbConnectParamsXml.SetConnectionString(AValue: string);
79var
80 URL: TURL;
81begin
82 URL := TURL.Create;
83 try
84 URL.AsString := AValue;
85 if (URL.Scheme <> 'file') and (AValue <> '') then
86 raise Exception.Create('Wrong connection string. Required file scheme.');
87 FileName := Copy(URL.Path, 2, Length(URL.Path));
88 finally
89 URL.Free;
90 end;
91end;
92
93{ TDatabaseXML }
94
95procedure TDatabaseXML.LoadNodeRecord(Row: TRecord; Node: TDOMNode);
96var
97 Node2: TDOMNode;
98 I: Integer;
99begin
100 Row.Values.Count := Row.Table.Fields.Count;
101 for I := 0 to Row.Values.Count - 1 do
102 Row.Values[I] := TValueClass(Row.Table.Fields[I].GetValueClass).Create;
103
104 Node2 := Node.FirstChild;
105 I := 0;
106 while Assigned(Node2) and (Node2.NodeName = 'Value') and (I < Row.Values.Count) do begin
107 case Row.Table.Fields[I].DataType.FieldType of
108 ftString: TValueString(Row.Values[I]).Value := string(Node2.TextContent);
109 ftInteger: TValueInteger(Row.Values[I]).Value := StrToInt(string(Node2.TextContent));
110 ftDateTime: if Node2.TextContent <> '' then
111 TValueDateTime(Row.Values[I]).Value := XMLTimeToDateTime(string(Node2.TextContent));
112 ftBoolean: TValueBoolean(Row.Values[I]).Value := StrToBool(string(Node2.TextContent));
113 end;
114 Node2 := Node2.NextSibling;
115 Inc(I);
116 end;
117end;
118
119procedure TDatabaseXML.SaveNodeRecord(Row: TRecord; Node: TDOMNode);
120var
121 I: Integer;
122 NewNode: TDOMNode;
123begin
124 for I := 0 to Row.Values.Count - 1 do begin;
125 NewNode := Node.OwnerDocument.CreateElement('Value');
126 Node.AppendChild(NewNode);
127 case Row.Table.Fields[I].DataType.FieldType of
128 ftString: NewNode.TextContent := UnicodeString(TValueString(Row.Values[I]).Value);
129 ftInteger: NewNode.TextContent := UnicodeString(IntToStr(TValueInteger(Row.Values[I]).Value));
130 ftDateTime: NewNode.TextContent := UnicodeString(DateTimeToXMLTime(TValueDateTime(Row.Values[I]).Value));
131 ftBoolean: NewNode.TextContent := UnicodeString(BoolToStr(TValueBoolean(Row.Values[I]).Value));
132 ftFloat: NewNode.TextContent := UnicodeString(FloatToStr(TValueFloat(Row.Values[I]).Value));
133 end;
134 end;
135end;
136
137procedure TDatabaseXML.LoadNodeRecords(Records: TRecords; Node: TDOMNode);
138var
139 Node2: TDOMNode;
140 NewRecord: TRecord;
141begin
142 Records.Count := 0;
143 Node2 := Node.FirstChild;
144 while Assigned(Node2) and (Node2.NodeName = 'Record') do begin
145 NewRecord := TRecord.Create;
146 NewRecord.Table := Records.Table;
147 LoadNodeRecord(NewRecord, Node2);
148 Records.Add(NewRecord);
149 Node2 := Node2.NextSibling;
150 end;
151end;
152
153procedure TDatabaseXML.SaveNodeRecords(Records: TRecords; Node: TDOMNode);
154var
155 I: Integer;
156 NewNode: TDOMNode;
157begin
158 for I := 0 to Records.Count - 1 do begin;
159 NewNode := Node.OwnerDocument.CreateElement('Record');
160 Node.AppendChild(NewNode);
161 SaveNodeRecord(Records[I], NewNode);
162 end;
163end;
164
165procedure TDatabaseXML.LoadNodeField(Field: TField; Node: TDOMNode);
166begin
167 Field.Name := ReadString(Node, 'Name', '');
168 Field.DataType := Field.Table.DbClient.ClientType.DataTypes.SearchByType(TFieldType(ReadInteger(Node, 'Type', 0)));
169 Field.TextBefore := ReadString(Node, 'TextBefore', '');
170 Field.TextAfter := ReadString(Node, 'TextAfter', '');
171end;
172
173procedure TDatabaseXML.SaveNodeField(Field: TField; Node: TDOMNode);
174begin
175 WriteString(Node, 'Name', Field.Name);
176 WriteInteger(Node, 'Type', Integer(Field.DataType.FieldType));
177 WriteString(Node, 'TextBefore', Field.TextBefore);
178 WriteString(Node, 'TextAfter', Field.TextAfter);
179end;
180
181procedure TDatabaseXML.LoadNodeFields(Fields: TFields; Node: TDOMNode);
182var
183 Node2: TDOMNode;
184 NewField: TField;
185begin
186 Fields.Count := 0;
187 Node2 := Node.FirstChild;
188 while Assigned(Node2) and (Node2.NodeName = 'Field') do begin
189 NewField := TField.Create;
190 NewField.Table := Fields.Table;
191 LoadNodeField(NewField, Node2);
192 Fields.Add(NewField);
193 Node2 := Node2.NextSibling;
194 end;
195end;
196
197procedure TDatabaseXML.SaveNodeFields(Fields: TFields; Node: TDOMNode);
198var
199 I: Integer;
200 NewNode: TDOMNode;
201begin
202 for I := 0 to Fields.Count - 1 do begin;
203 NewNode := Node.OwnerDocument.CreateElement('Field');
204 Node.AppendChild(NewNode);
205 SaveNodeField(Fields[I], NewNode);
206 end;
207end;
208
209procedure TDatabaseXML.LoadNodeTable(Table: TTable; Node: TDOMNode);
210var
211 NewNode: TDOMNode;
212begin
213 Table.Name := ReadString(Node, 'Name', '');
214 Table.Caption := ReadString(Node, 'Caption', '');
215
216 NewNode := Node.FindNode('Fields');
217 if Assigned(NewNode) then
218 LoadNodeFields(Table.Fields, NewNode);
219
220 NewNode := Node.FindNode('Records');
221 if Assigned(NewNode) then
222 LoadNodeRecords(Table.Records, NewNode);
223end;
224
225procedure TDatabaseXML.SaveNodeTable(Table: TTable; Node: TDOMNode);
226var
227 NewNode: TDOMNode;
228begin
229 WriteString(Node, 'Name', Table.Name);
230 WriteString(Node, 'Caption', Table.Caption);
231
232 NewNode := Node.OwnerDocument.CreateElement('Fields');
233 Node.AppendChild(NewNode);
234 SaveNodeFields(Table.Fields, NewNode);
235
236 NewNode := Node.OwnerDocument.CreateElement('Records');
237 Node.AppendChild(NewNode);
238 SaveNodeRecords(Table.Records, NewNode);
239end;
240
241procedure TDatabaseXML.LoadNodeTables(Tables: TTables; Node: TDOMNode);
242var
243 Node2: TDOMNode;
244 NewTable: TTable;
245begin
246 Tables.Count := 0;
247 Node2 := Node.FirstChild;
248 while Assigned(Node2) and (Node2.NodeName = 'Table') do begin
249 NewTable := TTable.Create;
250 NewTable.DbClient := Tables.DbClient;
251 LoadNodeTable(NewTable, Node2);
252 Tables.Add(NewTable);
253 Node2 := Node2.NextSibling;
254 end;
255end;
256
257procedure TDatabaseXML.SaveNodeTables(Tables: TTables; Node: TDOMNode);
258var
259 I: Integer;
260 NewNode: TDOMNode;
261begin
262 for I := 0 to Tables.Count - 1 do begin;
263 NewNode := Node.OwnerDocument.CreateElement('Table');
264 Node.AppendChild(NewNode);
265 SaveNodeTable(Tables[I], NewNode);
266 end;
267end;
268
269procedure TDatabaseXML.LoadFromFile(FileName: string);
270var
271 Doc: TXMLDocument;
272 RootNode: TDOMNode;
273 NewNode: TDOMNode;
274begin
275 ReadXMLFile(Doc, FileName);
276 with Doc do try
277 if Doc.DocumentElement.NodeName <> 'MyData' then
278 raise Exception.Create(SWrongFileFormat);
279 RootNode := Doc.DocumentElement;
280 with RootNode do begin
281 NewNode := FindNode('Tables');
282 if Assigned(NewNode) then
283 LoadNodeTables(Tables, NewNode);
284 end;
285 finally
286 Doc.Free;
287 end;
288end;
289
290procedure TDatabaseXML.SaveToFile(FileName: string);
291var
292 NewNode: TDOMNode;
293 Doc: TXMLDocument;
294 RootNode: TDOMNode;
295begin
296 if FileName = '' then exit;
297 Doc := TXMLDocument.Create;
298 with Doc do try
299 RootNode := CreateElement('MyData');
300 AppendChild(RootNode);
301 with RootNode do begin
302 NewNode := OwnerDocument.CreateElement('Tables');
303 AppendChild(NewNode);
304 SaveNodeTables(Tables, NewNode);
305 end;
306 if Pos(DirectorySeparator, FileName) > 0 then
307 ForceDirectories(ExtractFileDir(FileName));
308 WriteXMLFile(Doc, FileName);
309 finally
310 Doc.Free;
311 end;
312end;
313
314procedure TDatabaseXML.Expect(var Source: string; Text: string);
315var
316 Found: string;
317begin
318 Found := GetNextPart(Source);
319 if Found <> Text then
320 raise Exception.Create('Expected ' + Text + ' but ' + Found + ' found.');
321end;
322
323function TDatabaseXML.CheckNext(var Source: string; Text: string): Boolean;
324var
325 Found: string;
326 SourceCopy: string;
327begin
328 SourceCopy := Source;
329 Found := GetNextPart(SourceCopy);
330 if Found = Text then begin
331 Source := SourceCopy;
332 Result := True;
333 end else Result := False;
334end;
335
336function TDatabaseXML.GetNextPart(var Text: string; Separator: string = ' '): string;
337begin
338 if Pos(Separator, Text) > 0 then begin
339 Result := Trim(Copy(Text, 1, Pos(Separator, Text) - Length(Separator)));
340 Delete(Text, 1, Pos(Separator, Text));
341 end else begin
342 Result := Text;
343 Text := '';
344 end;
345end;
346
347function TDatabaseXML.TableCreateIfNotExists(Name: string): TTable;
348begin
349 Result := Tables.SearchByName(Name);
350 if not Assigned(Result) then begin
351 Tables.AddNew(Name);
352 end;
353end;
354
355function TDatabaseXML.FieldCreateIfNotExists(TableName, FieldName: string; DataType: TDataType): TField;
356var
357 Table: TTable;
358begin
359 TableCreateIfNotExists(TableName);
360 Table := Tables.SearchByName(TableName);
361 Result := Table.Fields.SearchByName(FieldName);
362 if not Assigned(Result) then begin
363 Table.Fields.AddNew(FieldName, DataType);
364 end;
365end;
366
367procedure TDatabaseXML.QuerySelect(Text: string; DbRows: TDbRows = nil);
368var
369 Command: string;
370 Columns: string;
371 TableName: string;
372 Table: TTable;
373 NewRecord: TDictionaryStringString;
374 I: Integer;
375 F: Integer;
376 WhereName: string;
377 WhereValue: string;
378begin
379 DbRows.Count := 0;
380 Columns := GetNextPart(Text);
381 Expect(Text, 'FROM');
382 TableName := GetNextPart(Text);
383 if CheckNext(Text, 'WHERE') then begin
384 WhereName := GetNextPart(Text);
385 Command := GetNextPart(Text);
386 if Command = '=' then begin
387 WhereValue := GetNextPart(Text);
388 end else raise Exception.Create('Expression error');
389 end;
390 if TableName = 'Model' then begin
391 if Columns = '*' then begin
392 for I := 0 to Tables.Count - 1 do begin
393 NewRecord := TDictionaryStringString.Create;
394 NewRecord.Add('Name', TTable(Tables[I]).Name);
395 NewRecord.Add('Caption', TTable(Tables[I]).Caption);
396 DbRows.Add(NewRecord);
397 end;
398 end else
399 if Columns = 'COUNT(*)' then begin
400 NewRecord := TDictionaryStringString.Create;
401 NewRecord.Add('COUNT(*)', IntToStr(Tables.Count));
402 DbRows.Add(NewRecord);
403 end else raise Exception.Create('Unsupported columns ' + Columns + ' specification');
404 end else
405 if TableName = 'ModelField' then begin
406 if WhereName = 'Model' then
407 Table := Tables.SearchByName(WhereValue)
408 else Table := nil;
409 if Assigned(Table) then begin
410 if Columns = '*' then begin
411 for I := 0 to Table.Fields.Count - 1 do begin
412 NewRecord := TDictionaryStringString.Create;
413 NewRecord.Add('Name', TField(Table.Fields[I]).Name);
414 NewRecord.Add('Caption', TField(Table.Fields[I]).TextBefore);
415 NewRecord.Add('Model', Table.Name);
416 NewRecord.Add('DataType', TField(Table.Fields[I]).DataType.Name);
417 DbRows.Add(NewRecord);
418 end;
419 end else
420 if Columns = 'COUNT(*)' then begin
421 NewRecord := TDictionaryStringString.Create;
422 NewRecord.Add('COUNT(*)', IntToStr(Table.Fields.Count));
423 DbRows.Add(NewRecord);
424 end else raise Exception.Create('Unsupported columns ' + Columns + ' specification');
425 end else raise Exception.Create(Format(STableNotFound, [WhereValue]));
426 end else begin
427 Table := Tables.SearchByName(TableName);
428 if Assigned(Table) then begin
429 if Columns = '*' then begin
430 for I := 0 to Table.Records.Count - 1 do begin
431 NewRecord := TDictionaryStringString.Create;
432 for F := 0 to Table.Fields.Count - 1 do
433 NewRecord.Add(TField(Table.Fields[F]).Name, TValue(TRecord(Table.Records[I]).Values[I]).GetString);
434 DbRows.Add(NewRecord);
435 end;
436 end else
437 if Columns = 'COUNT(*)' then begin
438 NewRecord := TDictionaryStringString.Create;
439 NewRecord.Add('COUNT(*)', IntToStr(Table.Records.Count));
440 DbRows.Add(NewRecord);
441 end else raise Exception.Create('Unsupported columns ' + Columns + ' specification');
442 end else raise Exception.Create(Format(STableNotFound, [TableName]));
443 end;
444end;
445
446procedure TDatabaseXML.QueryInsert(Text: string; DbRows: TDbRows);
447var
448 TableName: string;
449 Table: TTable;
450 Row: TRecord;
451 InsertValues: TStringList;
452 Field: TField;
453 FieldIndex: Integer;
454 ValueIndex: Integer;
455begin
456 InsertValues := TStringList.Create;
457 Expect(Text, 'INTO');
458 TableName := GetNextPart(Text);
459 Expect(Text, '(');
460 InsertValues.Add(GetNextPart(Text) + InsertValues.NameValueSeparator);
461 while CheckNext(Text, ',') do begin
462 InsertValues.Add(GetNextPart(Text) + InsertValues.NameValueSeparator);
463 end;
464 Expect(Text, ')');
465 Expect(Text, 'VALUES');
466 Expect(Text, '(');
467 ValueIndex := 0;
468 InsertValues.ValueFromIndex[ValueIndex] := GetNextPart(Text);
469 Inc(ValueIndex);
470 while CheckNext(Text, ',') do begin
471 InsertValues.ValueFromIndex[ValueIndex] := GetNextPart(Text);
472 Inc(ValueIndex);
473 end;
474 Expect(Text, ')');
475 if TableName = 'Model' then begin
476 Table := Tables.AddNew(InsertValues.Values['Name']);
477 Table.Caption := InsertValues.Values['Caption'];
478 end else
479 if TableName = 'ModelField' then begin
480 Table := Tables.SearchByName(InsertValues.Values['Model']);
481 if Assigned(Table) then begin
482 Field := Table.Fields.AddNew(InsertValues.Values['Name'], DbManager.DataTypes.SearchByType(ftString));
483 Field.TextBefore := InsertValues.Values['Caption'];
484 Field.DataType := DbManager.DataTypes.SearchByName(InsertValues.Values['DataType']);
485 end else raise Exception.Create(Format(STableNotFound, [InsertValues.Values['Model']]));
486 end else begin
487 Table := Tables.SearchByName(TableName);
488 if Assigned(Table) then begin
489 Row := Table.Records.AddNew;
490 for ValueIndex := 0 to InsertValues.Count - 1 do begin
491 Field := Table.Fields.SearchByName(InsertValues.Names[ValueIndex]);
492 if Assigned(Field) then begin
493 FieldIndex := Table.Fields.IndexOf(Field);
494 Row.Values[FieldIndex].SetString(InsertValues.ValueFromIndex[ValueIndex]);
495 end else raise Exception.Create(Format(SColumnNotFoundInTable,
496 [InsertValues.Names[ValueIndex], TableName]));
497 end;
498 end else raise Exception.Create(Format(STableNotFound, [TableName]));
499 end;
500 InsertValues.Free;
501end;
502
503procedure TDatabaseXML.QueryDelete(Text: string; DbRows: TDbRows);
504var
505 TableName: string;
506 Table: TTable;
507 Row: TRecord;
508 Field: TField;
509 WhereValues: TStringList;
510 ValueName: string;
511begin
512 Expect(Text, 'FROM');
513 TableName := GetNextPart(Text);
514
515 if CheckNext(Text, 'WHERE') then begin
516 WhereValues := TStringList.Create;
517 ValueName := GetNextPart(Text);
518 Expect(Text, '=');
519 WhereValues.Add(ValueName + WhereValues.NameValueSeparator + GetNextPart(Text));
520 while CheckNext(Text, ',') do begin
521 ValueName := GetNextPart(Text);
522 Expect(Text, '=');
523 WhereValues.Add(ValueName + WhereValues.NameValueSeparator + GetNextPart(Text));
524 end;
525 end else WhereValues := nil;
526
527 if TableName = 'Model' then begin
528 Table := Tables.SearchByName(WhereValues.Values['Name']);
529 if Assigned(Table) then begin
530 Tables.Remove(Table);
531 end else raise Exception.Create(Format(STableNotFound, [whereValues.Values['Name']]));
532 end else
533 if TableName = 'ModelField' then begin
534 Table := Tables.SearchByName(WhereValues.Values['Model']);
535 if Assigned(Table) then begin
536 Field := Table.Fields.SearchByName(WhereValues.Values['Name']);
537 if Assigned(Field) then begin
538 Table.Fields.Remove(Field);
539 end else raise Exception.Create(Format(SFieldNotFound, [WhereValues.Values['Name']]));
540 end else raise Exception.Create(Format(STableNotFound, [WhereValues.Values['Model']]));
541 end else begin
542 Table := Tables.SearchByName(TableName);
543 if Assigned(Table) then begin
544 Row := Table.Records.SearchByValues(WhereValues);
545 if Assigned(Row) then begin
546 Table.Records.Remove(Row);
547 end else raise Exception.Create('Row not found');
548 end else raise Exception.Create(Format(STableNotFound, [TableName]));
549 end;
550
551 if Assigned(WhereValues) then WhereValues.Free;
552end;
553
554procedure TDatabaseXML.QueryUpdate(Text: string; DbRows: TDbRows);
555var
556 TableName: string;
557 Table: TTable;
558 Row: TRecord;
559 WhereValues: TStringList;
560 Field: TField;
561 Values: TStringList;
562 ValueIndex: Integer;
563 FieldIndex: Integer;
564 ValueName: string;
565begin
566 TableName := GetNextPart(Text);
567 Expect(Text, 'SET');
568 Values := TStringList.Create;
569 ValueName := GetNextPart(Text);
570 Expect(Text, '=');
571 Values.Add(ValueName + Values.NameValueSeparator + GetNextPart(Text));
572 while CheckNext(Text, ',') do begin
573 ValueName := GetNextPart(Text);
574 Expect(Text, '=');
575 Values.Add(ValueName + Values.NameValueSeparator + GetNextPart(Text));
576 end;
577
578 if CheckNext(Text, 'WHERE') then begin
579 WhereValues := TStringList.Create;
580 ValueName := GetNextPart(Text);
581 Expect(Text, '=');
582 WhereValues.Add(ValueName + WhereValues.NameValueSeparator + GetNextPart(Text));
583 while CheckNext(Text, ',') do begin
584 ValueName := GetNextPart(Text);
585 Expect(Text, '=');
586 WhereValues.Add(ValueName + WhereValues.NameValueSeparator + GetNextPart(Text));
587 end;
588 end else WhereValues := nil;
589
590 if TableName = 'Model' then begin
591 Table := Tables.SearchByName(WhereValues.Values['Name']);
592 if Assigned(Table) then begin
593 //Table.Name := Values.Values['Name'];
594 if Values.IndexOfName('Caption') <> -1 then
595 Table.Caption := Values.Values['Caption'];
596 end else raise Exception.Create(Format(STableNotFound, [WhereValues.Values['Name']]));
597 end else
598 if TableName = 'ModelField' then begin
599 Table := Tables.SearchByName(WhereValues.Values['Model']);
600 if Assigned(Table) then begin
601 Field := Table.Fields.SearchByName(WhereValues.Values['Name']);
602 if Assigned(Field) then begin
603 if Values.IndexOfName('Name') <> -1 then
604 Field.Name := Values.Values['Name'];
605 if Values.IndexOfName('Caption') <> -1 then
606 Field.TextBefore := Values.Values['Caption'];
607 if Values.IndexOfName('DataType') <> -1 then
608 Field.DataType := DbManager.DataTypes.SearchByName(Values.Values['DataType']);
609 end else raise Exception.Create(Format(SFieldNotFound, [WhereValues.Values['Name']]));
610 end else raise Exception.Create(Format(STableNotFound, [WhereValues.Values['Model']]));
611 end else begin
612 Table := Tables.SearchByName(TableName);
613 if Assigned(Table) then begin
614 Row := Table.Records.SearchByValues(WhereValues);
615 for ValueIndex := 0 to Values.Count - 1 do begin
616 Field := Table.Fields.SearchByName(Values.Names[ValueIndex]);
617 if Assigned(Field) then begin
618 FieldIndex := Table.Fields.IndexOf(Field);
619 TValue(Row.Values[FieldIndex]).SetString(Values.ValueFromIndex[ValueIndex]);
620 end else raise Exception.Create(Format(SColumnNotFoundInTable,
621 [Values.Names[ValueIndex], TableName]));
622 end;
623 end else raise Exception.Create(Format(STableNotFound, [TableName]));
624 end;
625
626 if Assigned(WhereValues) then WhereValues.Free;
627 Values.Free;
628end;
629
630procedure TDatabaseXML.Query(Text: string; DbRows: TDbRows = nil);
631var
632 Command: string;
633begin
634 Command := GetNextPart(Text);
635 if Command = 'SELECT' then QuerySelect(Text, DbRows)
636 else if Command = 'INSERT' then QueryInsert(Text, DbRows)
637 else if Command = 'DELETE' then QueryDelete(Text, DbRows)
638 else if Command = 'UPDATE' then QueryUpdate(Text, DbRows)
639 else raise Exception.Create(Format(SUnsupportedSqlCommand, [Command]));
640end;
641
642procedure TDatabaseXML.Load;
643begin
644 FileName := TDbConnectParamsXml(ConnectProfile.Params).FileName;
645 Tables.DbClient := Self;
646 if FileExists(FileName) then
647 LoadFromFile(FileName);
648
649(*
650 TableCreateIfNotExists('Model');
651 TableCreateIfNotExists('ModelField');
652 TableCreateIfNotExists('DataType');
653 TableCreateIfNotExists('Module');
654
655 FieldCreateIfNotExists('ModelField', 'Name', DbManager.DataTypes.SearchByType(ftString));
656 FieldCreateIfNotExists('ModelField', 'Caption', DbManager.DataTypes.SearchByType(ftString));
657 FieldCreateIfNotExists('ModelField', 'Model', DbManager.DataTypes.SearchByType(ftString));
658 FieldCreateIfNotExists('ModelField', 'DataType', DbManager.DataTypes.SearchByType(ftString));
659 FieldCreateIfNotExists('Model', 'Name', DbManager.DataTypes.SearchByType(ftString));
660 FieldCreateIfNotExists('Model', 'Caption', DbManager.DataTypes.SearchByType(ftString));
661 FieldCreateIfNotExists('Model', 'Module', DbManager.DataTypes.SearchByType(ftString));
662 FieldCreateIfNotExists('Model', 'System', DbManager.DataTypes.SearchByType(ftBoolean));
663 FieldCreateIfNotExists('DataType', 'Name', DbManager.DataTypes.SearchByType(ftString));
664 FieldCreateIfNotExists('DataType', 'Caption', DbManager.DataTypes.SearchByType(ftString));
665 FieldCreateIfNotExists('DataType', 'FieldType', DbManager.DataTypes.SearchByType(ftInteger));
666 FieldCreateIfNotExists('Module', 'Name', DbManager.DataTypes.SearchByType(ftString));
667 FieldCreateIfNotExists('Module', 'Caption', DbManager.DataTypes.SearchByType(ftString));
668 *)
669end;
670
671procedure TDatabaseXML.Save;
672begin
673 SaveToFile(FileName);
674end;
675
676constructor TDatabaseXML.Create;
677begin
678 Tables := TTables.Create;
679 inherited;
680end;
681
682destructor TDatabaseXML.Destroy;
683begin
684 FreeAndNil(Tables);
685 inherited;
686end;
687
688end.
689
Note: See TracBrowser for help on using the repository browser.