Changeset 22 for trunk


Ignore:
Timestamp:
Mar 24, 2018, 12:33:48 AM (7 years ago)
Author:
chronos
Message:
  • Modified: Tables creation/deletion using SQL syntax for XML backend.
Location:
trunk
Files:
12 edited

Legend:

Unmodified
Added
Removed

  • trunk/DbEngines/UEngineXML.pas

    r21 r22  
    3030    procedure LoadFromFile(FileName: string);
    3131    procedure SaveToFile(FileName: string);
     32    procedure Expect(var Source: string; Text: string);
     33    function CheckNext(var Source: string; Text: string): Boolean;
    3234    function GetNextPart(var Text: string; Separator: string = ' '): string;
    3335  protected
    … …  
    304306end;
    305307
     308procedure TDatabaseXML.Expect(var Source: string; Text: string);
     309var
     310  Found: string;
     311begin
     312  Found := GetNextPart(Source);
     313  if Found <> Text then
     314    raise Exception.Create('Expected ' + Text + ' but ' + Found + ' found.');
     315end;
     316
     317function TDatabaseXML.CheckNext(var Source: string; Text: string): Boolean;
     318var
     319  Found: string;
     320  SourceCopy: string;
     321begin
     322  SourceCopy := Source;
     323  Found := GetNextPart(SourceCopy);
     324  if Found = Text then begin
     325    Source := SourceCopy;
     326    Result := True;
     327  end else Result := False;
     328end;
     329
    306330function TDatabaseXML.GetNextPart(var Text: string; Separator: string = ' '): string;
    307331begin
    … …  
    324348  I: Integer;
    325349  F: Integer;
     350  Row: TRecord;
     351  WhereName: string;
     352  WhereValue: string;
     353  InsertValues: TStringList;
     354  Field: TField;
     355  FieldIndex: Integer;
     356  NewValue: TValue;
     357  ValueIndex: Integer;
    326358begin
    327359  Command := GetNextPart(Text);
    328360  if Command = 'SELECT' then begin
    329361    Columns := GetNextPart(Text);
    330     Command := GetNextPart(Text);
    331     if Command = 'FROM' then begin
    332       TableName := GetNextPart(Text);
    333     end else raise Exception.Create('No table specified with FROM');
     362    Expect(Text, 'FROM');
     363    TableName := GetNextPart(Text);
    334364    Table := Tables.SearchByName(TableName);
    335365    if Assigned(Table) then begin
    … …  
    350380    end else raise Exception.Create('Table ' + TableName + ' not found.');
    351381  end else
    352   if Command = 'CREATE' then begin
    353     Command := GetNextPart(Text);
    354     if Command = 'TABLE' then begin
    355       TableName := GetNextPart(Text);
     382  if Command = 'INSERT' then begin
     383    InsertValues := TStringList.Create;
     384    Expect(Text, 'INTO');
     385    TableName := GetNextPart(Text);
     386    Expect(Text, '(');
     387    InsertValues.Add(GetNextPart(Text) + InsertValues.NameValueSeparator);
     388    while CheckNext(Text, ',') do begin
     389      InsertValues.Add(GetNextPart(Text) + InsertValues.NameValueSeparator);
     390    end;
     391    Expect(Text, ')');
     392    Expect(Text, 'VALUES');
     393    Expect(Text, '(');
     394    ValueIndex := 0;
     395    InsertValues.ValueFromIndex[ValueIndex] := GetNextPart(Text);
     396    Inc(ValueIndex);
     397    while CheckNext(Text, ',') do begin
     398      InsertValues.ValueFromIndex[ValueIndex] := GetNextPart(Text);
     399      Inc(ValueIndex);
     400    end;
     401    Expect(Text, ')');
     402    if TableName = 'Model' then begin
    356403      Table := TTable.Create;
    357       Table.Name := TableName;
     404      Table.Name := InsertValues.Values['Name'];
     405      Table.Caption := InsertValues.Values['Caption'];
    358406      Table.DbClient := Self;
    359       Tables.Add(Table);;
    360     end else raise Exception.Create('TABLE keyword expected');
     407      Tables.Add(Table);
     408    end else begin
     409      Table := Tables.SearchByName(TableName);
     410      if Assigned(Table) then begin
     411        Row := TRecord.Create;
     412        Row.Parent := Table;
     413        Row.InitValues;
     414        for ValueIndex := 0 to InsertValues.Count - 1 do begin
     415          Field := Table.Fields.SearchByName(InsertValues.Names[ValueIndex]);
     416          FieldIndex := Table.Fields.IndexOf(Field);
     417          TValue(Row.Values[FieldIndex]).SetString(InsertValues.ValueFromIndex[ValueIndex]);
     418        end;
     419        Table.Records.Add(Row);
     420      end else raise Exception.Create(Format('Table %s not found', [TableName]));
     421    end;
     422    InsertValues.Free;
    361423  end else
    362   if Command = 'DROP' then begin
    363     Command := GetNextPart(Text);
    364     if Command = 'TABLE' then begin
    365       TableName := GetNextPart(Text);
     424  if Command = 'DELETE' then begin
     425    Expect(Text, 'FROM');
     426    TableName := GetNextPart(Text);
     427    if CheckNext(Text, 'WHERE') then begin
     428      WhereName := GetNextPart(Text);
     429      Command := GetNextPart(Text);
     430      if Command = '=' then begin
     431        WhereValue := GetNextPart(Text);
     432      end else raise Exception.Create('Expression error');
     433    end;
     434    if TableName = 'Model' then begin
     435      Table := Tables.SearchByName(WhereValue);
     436      if Assigned(Table) then begin
     437        Tables.Remove(Table);
     438      end else raise Exception.Create(Format('Table %s not found', [whereValue]));
     439    end else begin
    366440      Table := Tables.SearchByName(TableName);
    367       if Assigned(Table) then Tables.Remove(Table)
    368       else raise Exception.Create('Table ' + TableName + ' not found');
    369     end else raise Exception.Create('TABLE keyword expected');
     441      if Assigned(Table) then begin
     442        Row := Table.Records.SearchByValue(WhereName, WhereValue);
     443        if Assigned(Row) then begin
     444          Table.Records.Remove(Row);
     445        end else raise Exception.Create('Row not found');
     446      end else raise Exception.Create(Format('Table %s not found', [TableName]));
     447    end;
    370448  end else
    371449    raise Exception.Create('Unsupported SQL command ' + Command);
    … …  
    380458begin
    381459  FileName := TDbConnectParamsXml(ConnectProfile.Params).FileName;
     460  Tables.DbClient := Self;
    382461  if FileExists(FileName) then
    383462    LoadFromFile(FileName);

  • trunk/Forms/UFormFields.pas

    r20 r22  
    9191  if FormField.ShowModal = mrOk then begin
    9292    FormField.Save(NewField);
    93     Fields.Add(NewField);
     93    Fields.Table.DbClient.Query('INSERT INTO ModelField ( Name , TextBefore) VALUES ( ' +
     94      NewField.Name + ' , ' + NewField.TextBefore + ' )');
    9495    ReloadList;
    9596  end else NewField.Free;
    … …  
    107108    if FormField.ShowModal = mrOk then begin
    108109      FormField.Save(TField(ListView1.Selected.Data));
     110      Fields.Table.DbClient.Query('UPDATE ModelField SET TextBefore = ' + TField(ListView1.Selected.Data).TextBefore +
     111        ' WHERE Name = ' + TField(ListView1.Selected.Data).Name);
    109112      ReloadList;
    110113    end;
    … …  
    120123begin
    121124  if Assigned(ListView1.Selected) then begin
    122     Fields.Remove(ListView1.Selected.Data);
     125    Fields.Table.DbClient.Query('DELETE FROM ModelField WHERE Name = ' + TField(ListView1.Selected.Data).Name);
    123126    ReloadList;
    124127    UpdateInterface;
    … …  
    152155
    153156procedure TFormFields.ReloadList;
     157var
     158  DbRows: TDbRows;
     159  NewField: TField;
     160  I: Integer;
    154161begin
     162  DbRows := TDbRows.Create;
     163  Fields.Table.DbClient.Query('SELECT * FROM ModelField WHERE Model = ' + Fields.Table.Name, DbRows);
     164  for I := 0 to DbRows.Count - 1 do begin
     165    NewField := TField.Create;
     166    NewField.Table := Fields.Table;
     167    Fields.Add(NewField);
     168  end;
     169  DbRows.Free;
     170
    155171  ListView1.Items.Count := Fields.Count;
    156172  ListView1.Repaint;

  • trunk/Forms/UFormMain.lfm

    r19 r22  
    55  Width = 1250
    66  Caption = 'MyData'
    7   ClientHeight = 819
     7  ClientHeight = 815
    88  ClientWidth = 1250
    9   DesignTimePPI = 144
    109  Menu = MainMenu1
    1110  OnActivate = FormActivate
    1211  OnClose = FormClose
    1312  OnShow = FormShow
    14   LCLVersion = '1.8.2.0'
     13  LCLVersion = '1.8.0.4'
    1514  WindowState = wsMaximized
    1615  object StatusBar1: TStatusBar
    1716    Left = 0
    18     Height = 36
    19     Top = 783
     17    Height = 30
     18    Top = 785
    2019    Width = 1250
    2120    Panels = <>
     21  end
     22  object CoolBar1: TCoolBar
     23    Left = 0
     24    Height = 43
     25    Top = 0
     26    Width = 1250
     27    AutoSize = True
     28    Bands = <   
     29      item
     30        Break = False
     31        Control = ToolBar1
     32        MinHeight = 40
     33        MinWidth = 90
     34        Width = 179
     35      end>
     36    Images = Core.ImageList1
     37    object ToolBar1: TToolBar
     38      AnchorSideLeft.Control = CoolBar1
     39      AnchorSideTop.Control = CoolBar1
     40      Left = 24
     41      Height = 33
     42      Top = 5
     43      Width = 108
     44      Align = alNone
     45      BorderSpacing.Left = 22
     46      BorderSpacing.Top = 3
     47      Caption = 'ToolBar1'
     48      EdgeInner = esNone
     49      EdgeOuter = esNone
     50      Images = Core.ImageList1
     51      TabOrder = 0
     52      Transparent = True
     53      object ToolButton1: TToolButton
     54        Left = 1
     55        Top = 0
     56        Action = Core.ADatabaseConnect
     57      end
     58      object ToolButton2: TToolButton
     59        Left = 37
     60        Top = 0
     61        Action = Core.ADatabaseDisconnect
     62      end
     63      object ToolButton3: TToolButton
     64        Left = 73
     65        Top = 0
     66        Action = Core.APreferences
     67      end
     68    end
    2269  end
    2370  object MainMenu1: TMainMenu

  • trunk/Forms/UFormMain.pas

    r20 r22  
    1414
    1515  TFormMain = class(TForm)
     16    CoolBar1: TCoolBar;
    1617    MainMenu1: TMainMenu;
    1718    MenuItem1: TMenuItem;
    … …  
    2526    MenuItemPreferences: TMenuItem;
    2627    StatusBar1: TStatusBar;
     28    ToolBar1: TToolBar;
     29    ToolButton1: TToolButton;
     30    ToolButton2: TToolButton;
     31    ToolButton3: TToolButton;
    2732    procedure FormActivate(Sender: TObject);
    2833    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    … …  
    5156begin
    5257  Core.Init;
     58  // TODO: Toolbar height is incorrectly calculated
     59  ToolBar1.ButtonHeight := ToolBar1.Height;
    5360end;
    5461

  • trunk/Forms/UFormTables.pas

    r21 r22  
    119119  if FormTable.ShowModal = mrOk then begin
    120120    FormTable.Save(NewTable);
    121     Tables.DbClient.Query('CREATE TABLE ' + NewTable.Name + ' (ID INTEGER)');
     121    Tables.DbClient.Query('INSERT INTO Model ( Name , Caption ) VALUES ( ' +
     122      NewTable.Name + ' , ' + NewTable.Caption + ' )');
    122123    ReloadList;
    123124  end else NewTable.Free;
    … …  
    130131    if FormTable.ShowModal = mrOk then begin
    131132      FormTable.Save(TTable(ListView1.Selected.Data));
     133      DbClient.Query('UPDATE Model SET Name = ' + TTable(ListView1.Selected.Data).Name);
    132134      ReloadList;
    133135    end;
    … …  
    138140begin
    139141  if Assigned(ListView1.Selected) then begin
    140     if MessageDlg(SRemoveTable, Format(SRemoveTableConfirm, [TTable(ListView1.Selected.Data).Name]),
     142    if MessageDlg(SRemoveTable, Format(SRemoveTableConfirm, [TTable(ListView1.Selected.Data).Caption]),
    141143    mtConfirmation, [mbYes, mbNo], 0) = mrYes then begin
    142       Tables.DbClient.Query('DROP TABLE ' + TTable(ListView1.Selected.Data).Name);
     144      Tables.DbClient.Query('DELETE FROM Model WHERE Name = ' + TTable(ListView1.Selected.Data).Name);
    143145      ReloadList;
    144146    end;
    … …  
    175177      end;
    176178      for C := 0 to FormFields.Fields.Count - 1 do begin
    177         OldField := OldTable.Fields.FindByName(TField(FormFields.Fields[C]).Name);
     179        OldField := OldTable.Fields.SearchByName(TField(FormFields.Fields[C]).Name);
    178180        if Assigned(OldField) then begin
    179181          FI := OldTable.Fields.IndexOf(OldField);
    … …  
    210212procedure TFormTables.FormCreate(Sender: TObject);
    211213begin
    212   FTables := TTables.Create;
     214  FTables := TTables.Create(False);
    213215end;
    214216

  • trunk/Install/deb/debian/changelog

    r16 r22  
    1 mydata (1.5.0-0) precise; urgency=low
     1mydata (1.0.0-0) precise; urgency=low
    22
    3   * Original version 1.5.0 packaged with lazdebian
     3  * Original version 1.0.0 packaged with lazdebian
    44
    55 -- Chronos <robie@centrum.cz>  Sun, 1 Jan 2018 00:51:08 +0100

  • trunk/Languages/MyData.cs.po

    r20 r22  
    271271msgstr "Nástroje"
    272272
     273#: tformmain.toolbar1.caption
     274msgid "ToolBar1"
     275msgstr ""
     276
    273277#: tformpreferences.buttoncancel.caption
    274278msgctxt "tformpreferences.buttoncancel.caption"

  • trunk/Languages/MyData.po

    r20 r22  
    256256msgstr ""
    257257
     258#: tformmain.toolbar1.caption
     259msgid "ToolBar1"
     260msgstr ""
     261
    258262#: tformpreferences.buttoncancel.caption
    259263msgctxt "tformpreferences.buttoncancel.caption"

  • trunk/MyData.lpi

    r20 r22  
    2828          <SearchPaths>
    2929            <IncludeFiles Value="$(ProjOutDir)"/>
    30             <OtherUnitFiles Value="Forms;DbEngines;/usr/lib/mysql;/usr/lib64/mysql"/>
     30            <OtherUnitFiles Value="Forms;DbEngines;/usr/lib/mysql/;/usr/lib64/mysql/"/>
    3131            <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)-$(BuildMode)"/>
    3232          </SearchPaths>
    … …  
    226226    <SearchPaths>
    227227      <IncludeFiles Value="$(ProjOutDir)"/>
    228       <OtherUnitFiles Value="Forms;DbEngines;/usr/lib/mysql;/usr/lib64/mysql"/>
     228      <OtherUnitFiles Value="Forms;DbEngines;/usr/lib/mysql/;/usr/lib64/mysql/"/>
    229229      <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)-$(BuildMode)"/>
    230230    </SearchPaths>

  • trunk/UCore.lfm

    r20 r22  
    77  VerticalOffset = 229
    88  Width = 817
    9   PPI = 120
    109  object ImageList1: TImageList
    1110    Height = 32
    … …  
    16131612    top = 178
    16141613  end
     1614  object ScaleDPI1: TScaleDPI
     1615    AutoDetect = False
     1616    left = 366
     1617    top = 273
     1618  end
    16151619end

  • trunk/UCore.pas

    r21 r22  
    66
    77uses
    8   Classes, SysUtils, FileUtil, Controls, ActnList, UDatabase,
    9   UCoolTranslator, UApplicationInfo, UPersistentForm, Forms, URegistry;
     8  Classes, SysUtils, FileUtil, Controls, ActnList, UDatabase, UCoolTranslator,
     9  UApplicationInfo, UPersistentForm, Forms, URegistry, UScaleDPI;
    1010
    1111type
    … …  
    2323    ImageList1: TImageList;
    2424    PersistentForm1: TPersistentForm;
     25    ScaleDPI1: TScaleDPI;
    2526    procedure AAboutExecute(Sender: TObject);
    2627    procedure ADatabaseConnectExecute(Sender: TObject);

  • trunk/UDatabase.pas

    r21 r22  
    7575  TFields = class(TObjectList)
    7676    Table: TTable;
    77     function FindByName(Name: string): TField;
     77    function SearchByName(Name: string): TField;
    7878    procedure Assign(Source: TFields);
    7979  end;
    … …  
    8484    Parent: TTable;
    8585    Values: TValues;
     86    procedure InitValues;
    8687    procedure Assign(Source: TRecord);
    8788    constructor Create;
    … …  
    9495    Parent: TTable;
    9596    procedure Assign(Source: TRecords);
     97    function SearchByValue(Name, Value: string): TRecord;
    9698  end;
    9799
    … …  
    175177    function SearchByName(Name: string): TDataType;
    176178  end;
     179
     180  TDbRows = USqlDatabase.TDbRows;
    177181
    178182  { TDbClient }
    … …  
    577581end;
    578582
     583function TRecords.SearchByValue(Name, Value: string): TRecord;
     584var
     585  I: Integer;
     586  FieldIndex: Integer;
     587  Field: TField;
     588begin
     589  Result := nil;
     590  Field := Parent.Fields.SearchByName(Name);
     591  if Assigned(Field) then begin
     592    FieldIndex := Parent.Fields.IndexOf(Field);
     593    I := 0;
     594    while (I < Count) and (TValue(TRecord(Items[I]).Values[FieldIndex]).GetString <> Value) do Inc(I);
     595    if I < Count then Result := TRecord(Items[I])
     596      else Result := nil;
     597  end;
     598end;
     599
    579600{ TFields }
    580601
    581 function TFields.FindByName(Name: string): TField;
     602function TFields.SearchByName(Name: string): TField;
    582603var
    583604  I: Integer;
    … …  
    604625
    605626{ TRecord }
     627
     628procedure TRecord.InitValues;
     629var
     630  I: Integer;
     631begin
     632  Values.Clear;
     633  for I := 0 to Parent.Fields.Count - 1 do
     634    Values.Add(TField(Parent.Fields[I]).GetValueClass.Create);
     635end;
    606636
    607637procedure TRecord.Assign(Source: TRecord);
Note: See TracChangeset for help on using the changeset viewer.