3ddark

4 hours ago, Arnaud Bouchez said:

Generation of SQL with parameters should help the performance and security.

 

Can you explain with an example?

Delphi Simple ORM using ZeosDBO

https://github.com/3ddark/delphi-orm-test

Two different version.

v2 supported actions

    function GetList(AClass: TClass; var AList: TArray<TTable>; AFilter: string; ALock: Boolean; APermissionCheck: Boolean=True): Boolean;
    function GetListCustom(AClass: TClass; var AList: TArray<TTable>; AFields: TArray<TFieldDB>; AFilter: string; ALock: Boolean; APermissionCheck: Boolean=True): Boolean;

    function GetOne(ATable: TTable; AFilter: string; ALock: Boolean; APermissionCheck: Boolean=True): Boolean; overload;
    function GetOneCustom(ATable: TTable; AFields: TArray<TFieldDB>; AFilter: string; ALock: Boolean; APermissionCheck: Boolean=True): Boolean; overload;

    function GetOne(ATable: TTable; AID: Int64; ALock: Boolean; APermissionCheck: Boolean=True): Boolean; overload;
    function GetOneCustom(ATable: TTable; AFields: TArray<TFieldDB>; AID: Int64; ALock: Boolean; APermissionCheck: Boolean=True): Boolean; overload;

    function Insert(ATable: TTable; APermissionCheck: Boolean=True): Boolean; virtual;

    function Update(ATable: TTable; APermissionCheck: Boolean=True): Boolean; virtual;
    function CustomUpdate(ATable: TTable; AFields: TArray<TFieldDB>; APermissionCheck: Boolean=True): Boolean; virtual;

    function DeleteBatch(AClass: TClass; AFilter: string; APermissionCheck: Boolean=True): Boolean; overload;
    function DeleteBatch(ATables: TArray<TTable>; APermissionCheck: Boolean=True): Boolean; overload;
    function Delete(ATable: TTable; APermissionCheck: Boolean=True): Boolean; virtual;

    function LogicalSelect(AClass: TClass; var ATable: TTable; AFilter: string; ALock, AWithBegin, APermissionCheck: Boolean; AProcBusinessSelect: TBusinessSelectEvent): TEntityManager; virtual;
    function LogicalInsert(ATable: TTable; AWithBegin, AWithCommit, APermissionCheck: Boolean; AProcBusinessInsert: TBusinessOperationEvent): Boolean; virtual;
    function LogicalUpdate(ATable: TTable; AWithBegin, AWithCommit, APermissionCheck: Boolean; AProcBusinessUpdate: TBusinessOperationEvent): Boolean; virtual;
    function LogicalDelete(ATable: TTable; AWithBegin, AWithCommit, APermissionCheck: Boolean; AProcBusinessDelete: TBusinessOperationEvent): Boolean; virtual;

    procedure Listen(ATableName: string); virtual;
    procedure Unlisten(ATableName: string); virtual;
    procedure Notify(ATableName: string); virtual;

    function IsAuthorized(ATableSourceCode: string; APermissionType: TPermissionType; APermissionCheck: Boolean; AShowException: Boolean=True): Boolean;

    procedure Start(AConnection: TZAbstractConnection = nil);
    procedure Commit(AConnection: TZAbstractConnection = nil);
    procedure Rollback(AConnection: TZAbstractConnection = nil);

frmMain contain example for using methods
 

Thanks for your support @Remy Lebeau

Here is the Github Repo.

Use Zeos DB Connection and use PostgreSQL database

Simple class GetByID => Done

Simple class with OneToOne => Done

Simple class with OneToMany => waiting. I use to TArray<TAnyEntityClass> tkDynArray fill all data

After the GetById operation is done. I will add other features and check all

10 hours ago, Remy Lebeau said:

You are not actually reading the TPerson.Address property value to access the TAddress object.  AProp.PropertyType.AsInstance is not the way to do that, use AProp.GetValue() instead and cast the result to an object pointer, eg:

var
  ...
  LObj: TObject;
...
for AProp in ARelations do
begin
  LObj := AProp.GetValue(SomeModel).AsObject;
  LClass := LObj.ClassType;

  for AProp2 in AProp.PropertyType.GetProperties do
  begin
    if (AProp2.Visibility in [mvPublished, mvPublic]) then
    begin
      for LAttr in AProp2.GetAttributes do
      begin
        if (LAttr is ColumnAttribute) then
        begin
          if (AProp2.PropertyType.TypeKind in [tkString, tkUString, tkWString]) then
            AProp2.SetValue(LObj, 'Orange');
          Break;
        end;
      end;
    end;
  end;
end;
...

 

I was able to make the change exactly as you said in the tests I did last night.

Can I convert AProp2 to T?

Why do I need this?

I have a function like GetByID(AID: Int64; ALock: Boolean = False)

I want to Recursive invoke properties that come as tkClass and contain attributes "OneOne" or "OneMany".

(*
	Person Table
	id		name		sur_name	address_id
	1		3ddark		Thunder		2

	Address Table
	id		city		country
	1		Ankara		Turkey
	2		Istanbul	Turkey
*)
var
  LMan: TEntityManager;
  LPerson: TPerson;
begin
  LMan := TEntityManager.Create(DBConnection);
  LPerson := LMan.GetById<TPerson>(1, False);		//Here once call and see tkClass recursive call Address, or any class relations
  
  Writeln(LPerson.Id.ToString());			//1
  Writeln(LPerson.Name);					//3ddark
  Writeln(LPerson.SurName);					//Thunder
  Writeln(LPerson.Address.Id.ToString());	//2
  Writeln(LPerson.Address.City);			//Istanbul
  Writeln(LPerson.Address.Country);			//Turkey
end;






function TEntityManager.GetById<T>(AID: Int64, ALock: Boolean = False): T;
var
  LRelationID: Int64;
  ...
  LObj: TObject;
...
begin
  ...
  for AProp in ARelations do
  begin
    LObj := AProp.GetValue(SomeModel).AsObject;
    LClass := LObj.ClassType;
    //Normally TPerson when T comes first
    //But I need TAddress or any relations TXXX class as T
    AProp.SetValue(LObj, Self.GetById<(*Here dynamic classType like TAddress or TXxxx --->*)LObj.ClassType>(LRelationID, ALock)).AsObject;
  end;
  ...
end;

I hope I was able to explain my problem.

Thanks in advance.

  [Entity('addresses', 'public')]
  TAddress = class(TEntity)
  private
    FCity: string;
    FCountry: string;
  public
    [Column('city')]
    property City: string read FCity write FCity;
    [Column('country')]
    property Country: string read FCountry write FCountry;
  end;

  [Entity('persons', 'public')]
  TPerson = class(TEntity)
  private
    FName: string;
    FSurName: string;
    FAddress: TAddress;

    function GetFullName: string;
  public
    [Column('name')]
    property Name: string read FName write FName;
    [Column('sur_name')]
    property SurName: string read FSurName write FSurName;
    [NotMapped]
    property FullName: string read GetFullName;

    [OneToOne('')]
    property Address: TAddress read FAddress write FAddress;	//Access this property and modify (like City='Istanbul', Country='Turkey')
  end;

////////////////////////////////

function TEntity.GetQuery(AID: Int64; AWithSchema: Boolean): string;
var
  ACtx: TRttiContext;
  AType: TRttiType;
  AProp : TRttiProperty;
  LAttr : TCustomAttribute;

  LColName : string;
  LTableName : string;
  LColNames: string;
  LColID: string;
begin
  ACtx := TRttiContext.Create;
  try
    AType := ACtx.GetType(SomeClass.ClassType);
    LTableName := Self.GetTableName(AWithSchema);

    LColNames := '';
    for AProp in AType.GetProperties do
    begin
      if AProp.Visibility in [mvPublished, mvPublic] then
      begin
        for LAttr in AProp.GetAttributes do
        begin
          if LAttr is Column then
          begin
            LColName := Column(LAttr).ColumnName;
            if LColName = '' then
              raise Exception.Create('Column must bu declared.' + sLineBreak + 'If it not used, declare "NotMapped" attribute!!!');
            if LColName = 'id' then
              LColID := LColName
            else
              LColNames := LColNames + LColName + ',';
          end;
        end;
      end;
    end;

    if LColNames = '' then
      raise Exception.Create('SQL field_names not found!!!');

    LColNames := LColID + ',' + LColNames;

    Result := Trim('SELECT ' + LeftStr(LColNames, Length(LColNames)-1) + ' FROM ' + LTableName + ' WHERE ' + LeftStr(LColNames, 2) + '=' + IntToStr(AID));
  finally
    ACtx.Free;
  end;
end;

///////////////////////////////////////////
procedure Test
var
  ACtx: TRttiContext;
  AType: TRttiType;
  AProp, AProp2: TRttiProperty;
  LAttr: TCustomAttribute;
  LInst: TRttiInstanceType;
  ARelations: TArray<TRttiProperty>;
  LColName: string;
  LTableName: string;
  LColNames: string;
  LColID: string;
  LClass: TClass;
  LPointer: Pointer;
begin
  ACtx := TRttiContext.Create;
  try
    AType := ACtx.GetType(SomeModel.ClassType);
    SetLength(ARelations, 0);
    for AProp in AType.GetProperties do
    begin
      if (AProp.PropertyType.TypeKind = tkClass) and (AProp.IsReadable) and (AProp.IsWritable) and (AProp.Visibility in [mvPublished, mvPublic]) then
      begin
        for LAttr in AProp.GetAttributes do
        begin
          //access here class property and fill an array
          if (LAttr is OneToOne) or (LAttr is OneToMany) then
          begin
            SetLength(ARelations, Length(ARelations) + 1);
            AReletions[Length(ARelations) - 1] := AProp;
            Break;
          end;
        end;
      end;
    end;

    for AProp in ARelations do
    begin
      //HEREEEEE I WANT TO ACCESS model and update property values
      LInst := AProp.PropertyType.AsInstance;
      Move(LInst, LPointer, SizeOf(Pointer));

      AType := ACtx.GetType(LInst.Handle);
      for AProp2 in AType.GetProperties do
      begin
        if (AProp2.Visibility in [mvPublished, mvPublic]) then
        begin
          for LAttr in AProp2.GetAttributes do
          begin
            if (LAttr is ColumnAttribute) then
            begin
              if (AProp2.PropertyType.TypeKind = tkString) or (AProp2.PropertyType.TypeKind = tkUString) or (AProp2.PropertyType.TypeKind = tkWString) then
              begin
                AProp2.SetValue(LPointer, 'Orange');
                Break;
              end;
            end;
          end;
        end;
      end;
      LClass := AProp.PropertyType.AsInstance.MetaclassType;
    end;
  finally
    ACtx.free;
  end;
end;

I want to access  Address (FAddress) property and edited city and/or country values.

I can do anything in simple class with RTTI
I can do all SELECT, INSERT, UPDATE, DELETE operations.

But in order to be able to perform operations in classes with Relations, I must be able to perform the necessary operations to access these classes.

I'll add the Github link after I've made the final code edits.

I may have shown the exact code I wrote and the missing part.

NOTE: The codes may not work fully, I added it as a representation.

Thank you remmy

type
  [TTableNameAttribute('sys_days')]
  TSysDay = class(TTableBase)
  private
    FId: Int64;
    FDay: WideString;
...
...
...
   public
    [TFieldNameAttribute('id')]
    property Id: Int64 read FId write SetId;

    [TFieldNameAttribute('day')]
    property Day: WideString read FDay write SetDay;

    [TFieldNameAttribute('a')] property A: WideString
    [TFieldNameAttribute('b')] property B: Int64
    [TFieldNameAttribute('c')] property C: Double
  end;

Can I just get the value of an attribute

GetFieldAttribe('a');	//wrong example. Here I can check and find in the loop with the incoming parameter

GetFieldAttribe(Self.A);	//correct example. Here A is WideString Member. Not a class, not a object

5 hours ago, Lars Fosdal said:

You sort of posted the answer with your question.

Not sure what you are trying to improve?

I know it's a stupid question.

Can I get the attribute value for only one property?

Without sending any information as a string.
As an example I get the TableName via ClassType

Table is an object. But properties not and object

Hello,Can I access the attribute value of only one property?
For example :

var
  LDay: TSysDay;
  LFieldName: string;

LFieldName := GetAttribute(LDay.Day);

Sending a property of the class, such as getting the attribute information of it.

type
  TFieldNameAttribute = class(TCustomAttribute)
  strict private
    FName: string;
  public
    property Name: string read FName;
    constructor Create(AName: string);
  end;

//----------------------------------------------------
type
  [TSchemaNameAttribute('public')]
  [TTableNameAttribute('sys_days')]
  TSysDay = class(TTableBase)
  private
    FId: Int64;
    FDay: WideString;
    procedure SetId(const Value: Int64);
    procedure SetDay(const Value: WideString);
   public
    [TFieldNameAttribute('id')]
    property Id: Int64 read FId write SetId;

    [TFieldNameAttribute('day')]
    property Day: WideString read FDay write SetDay;
  end;
//---------------------------------------
function TTable.GetTableName: string;
var
  LC: TRttiContext;
  LT: TRttiType;
  LA: TCustomAttribute;
begin
  Result := '';
  LC := TRttiContext.Create;
  try
    LT := LC.GetType(Self.ClassType);
    for LA in LT.GetAttributes() do
      if LA is TTableNameAttribute then
      begin
        Result := TTableNameAttribute(LA).Name;
        Exit;
      end;
//Result is "sys_day"
  finally
    LC.Free
  end;
end;
//---------------------------------------
function TTable.GetFieldNames: string;
var
  LC: TRttiContext;
  LT: TRttiType;
  LP: TRttiProperty;
  LA: TCustomAttribute;
begin
  Result := '';
  LC := TRttiContext.Create;
  try
    LT := LC.GetType(Self.ClassType);
    for LP in LT.GetProperties() do
      for LA in LP.GetAttributes() do
        if LA is TFieldNameAttribute then
          Result := Result + TFieldNameAttribute(LA).Name + ', ';
    if Trim(Result) <> '' then
    begin
      Result := Trim(Result);
      Result := LeftStr(Result, Length(Result)-1);
    end;
//Result is "id, day"
  finally
    LC.Free
  end;
end;

The sort function is working. But when I sort for 100000 rows, it works very slowly.

What suggestions do you have for better performance. I'm only sorting for one column at a time. No multiple sorting

procedure TStringGrid.SortStringGrid(ACol: Integer);
var
  i, j : Integer;
  LTemp: TStringList;
  LSortType: TSortMode;
  LCompResult: Boolean;
begin
  Perform(WM_SETREDRAW, 0, 0);
  LTemp := TStringList.Create;
  try
    LSortType := smNone;
    for i := Self.FixedRows to Self.RowCount - 2 do
    begin
      for j:= i+1 to Self.RowCount-1 do
      begin
        //first sort or another column sort
        if (FSortType = smNone) or (FSortType = smDesc) or ((FSortType = smAsc) and (FSortCol <> ACol)) then
        begin
          if AnsiCompareText(Self.Cells[ACol, i], Self.Cells[ACol, j]) = GreaterThanValue then
          begin
            LTemp.Assign(Self.Rows[j]);
            Self.Rows[j].Assign(Self.Rows[i]);
            Self.Rows[i].Assign(LTemp);
          end;
          LSortType := smAsc;
        end
        else if (FSortType = smAsc) and (FSortCol = ACol) then  //sort same column asc to desc
        begin
          if AnsiCompareText(Self.Cells[ACol, i], Self.Cells[ACol, j]) = LessThanValue then
          begin
            LTemp.Assign(Self.Rows[i]);
            Self.Rows[i].Assign(Self.Rows[j]);
            Self.Rows[j].Assign(LTemp);
          end;
          LSortType := smDesc;
        end;
      end;
    end;
    FSortType := LSortType;
    FSortCol := ACol;
  finally
    LTemp.free;
    Perform(WM_SETREDRAW, 1, 0);
    Invalidate;
  end;
end;

This is another solution

unit MsgWaitForMultiple;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, System.SyncObjs;

type
  TForm3 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
  public
    Event: TEvent;
  end;

var
  Form3: TForm3;

implementation

{$R *.dfm}

procedure TForm3.Button1Click(Sender: TObject);
var
  Thrd : TThread;
begin
  Event.ResetEvent;

  Thrd := TThread.CreateAnonymousThread(
    procedure
    begin
      Sleep(10000);
      Event.SetEvent;
    end
  );

  Thrd.Start;

  while Event.WaitFor(0) = wrTimeOut do
  begin
    WaitMessage;
    Application.ProcessMessages;
  end;

  Memo1.Lines.Add('Thread bitti');
end;

procedure TForm3.FormCreate(Sender: TObject);
begin
  Event := TEvent.Create(nil, True, False, '');
end;

end.

@FPiette Add for loging I added deliberately

How to wait for the above thread to finish before the main thread freezes?

procedure TForm2.Button1Click(Sender: TObject);
var
  Thrd : TThread;
  msg: tagMSG;
  Ret: Cardinal;
begin
  Thrd := TThread.CreateAnonymousThread(
    procedure
    begin
      Sleep(10000);
      Memo1.Lines.Add('End of Thread');
    end
  );

  Thrd.Start;

  //The thread above is waiting for 10 seconds within itself. We will wait for the above thread to finish before the main thread freezes
  Ret := MsgWaitForMultipleObjects(0, Thrd, True, INFINITE, QS_ALLINPUT);
  //use with WaitMessage
  case Ret of
    WAIT_OBJECT_0: ;
    WAIT_OBJECT_0+1: ;
    WAIT_TIMEOUT: ;
  end;

  Memo1.Lines.Add('Thread finish');
end;

Hello,
I want to move rows in StringGrid, a Delphi component. (Delphi 7, TStringGrid)

• I fill the information in the stringrid as shown in the picture below.
• I also adjust the stringgrid settings.
• There is no problem with move to row

sGrid.FixedCols := 1;
sGrid.FixedRows := 1;
sGrid.Options := sGrid.Options + [goRowMoving];
 
procedure TFormX.sGridMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  gc: TGridCoord;
begin
  if Sender is TStringGrid then
  begin
    if TStringGridX(Sender).GridState in [gsRowMoving] then
    begin
      TStringGrid(Sender).MouseToCell(X, Y, gc.X, gc.Y);
      //get the row number of the first selected row
      FFromIndex := gc.Y;
    end;
  end;
end;

procedure TFormX.sGridMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
 gc: TGridCoord;
begin
  if Sender is TStringGrid then
  begin
    if TStringGridX(Sender).GridState in [gsRowMoving] then
    begin
      TStringGrid(Sender).MouseToCell(X, Y, gc.X, gc.Y);
      FToIndex := gc.Y;
    end;
  end;
end;

procedure TFormX.sGridMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var
   gc: TGridCoord;
begin
  if Sender is TStringGrid then
  begin
    if TStringGridX(Sender).GridState in [gsRowMoving] then
    begin
      TStringGrid(Sender).MouseToCell(X, Y, gc.X, gc.Y);
      //here I know which lines you can go
      Caption := IntToStr(gc.X) + ':' + IntToStr(gc.Y);
    end;
  end;
end;

procedure TFormX.sGridRowMoved(Sender: TObject; FromIndex, ToIndex: Integer);
begin
  //it also says which row to move to which row.
  //How can I cancel this operation if it is not the row I want.
end;

From the attached picture,
Example 1-) I can move the A9 code on line 10 between lines 2 and 15. I want to prevent the move outside of these lines.
Example 2-) F code in line 20 can be moved to lines 1, 16, 23, 27. I will also move F1 and F2 lines under this F code. When the move starts, I find the lines where the move can be done (1,16,23,27)

what I really want it may seem like a complicated situation.
How do I cancel only the line move job?
How do I make it move over only the lines I want in the move?

Thanks in advance.