record CRUD

record CRUD

unit core.recordCrud;
//The primary key is required for the update/delete 'where' condition
// cxg 2025-5-24
interface

uses
  SysUtils, Rtti;

type
  // Generate transaction SQL from a record
  TRecordCrud<T> = record
    class function Insert(const ARecord; const ATableName: string)
      : string; static;
    class function Delete(const ARecord; const ATableName, AKeyFields: string)
      : string; static;
    class function Update(const ARecord; const ATableName, AKeyFields: string)
      : string; static;
  private
    class function ProcessValue(const ARecord; const LRttiField: TRttiField): string; static;
  end;

implementation

class function TRecordCrud<T>.ProcessValue(const ARecord; const LRttiField: TRttiField): string;
begin
  if (@ARecord = nil) or (LRttiField = nil) then
    Exit;
  if LRttiField.FieldType.ToString = 'TDateTime' then
    Result := FormatDateTime('yyyy-mm-dd hh:nn:ss:zzz',
      LRttiField.GetValue(@ARecord).AsType<TDateTime>)
  else if LRttiField.FieldType.ToString = 'TDate' then
    Result := FormatDateTime('yyyy-mm-dd', LRttiField.GetValue(@ARecord)
      .AsType<TDate>)
  else if LRttiField.FieldType.ToString = 'TTime' then
    Result := FormatDateTime('hh:nn:ss:zzz', LRttiField.GetValue(@ARecord)
      .AsType<TTime>)
  else
    Result := LRttiField.GetValue(@ARecord).ToString;
  if (LRttiField.FieldType.ToString = 'string') or
    (LRttiField.FieldType.ToString = 'TDateTime') or
    (LRttiField.FieldType.ToString = 'TDate') or
    (LRttiField.FieldType.ToString = 'TTime') then
    Result := QuotedStr(Result);
end;

class function TRecordCrud<T>.Delete(const ARecord;
  const ATableName, AKeyFields: string): string;
var
  LRttiContext: TRttiContext;
  LRttiType: TRttiType;
  LRttiField: TRttiField;
  LWhere, LValue: string;
begin
  if (@ARecord = nil) or (ATableName = '') or (AKeyFields = '') then
    Exit;
  LRttiContext := TRttiContext.Create;
  try
    LRttiType := LRttiContext.GetType(TypeInfo(T));
    LValue := '';
    LWhere := '';
    for LRttiField in LRttiType.GetFields do
    begin
      if Pos(LRttiField.Name, AKeyFields) = 0 then
        Continue;
      LValue :=  ProcessValue(ARecord, LRttiField);
      LWhere := LWhere + ' and ' + LRttiField.Name + '=' + LValue;
    end;
    System.Delete(LWhere, 1, 5);
    Result := 'delete from ' + ATableName + ' where ' + LWhere;
  finally
    LRttiContext.Free;
  end;
end;

class function TRecordCrud<T>.Insert(const ARecord;
  const ATableName: string): string;
var
  LRttiContext: TRttiContext;
  LRttiType: TRttiType;
  LRttiField: TRttiField;
  LFields, LValues, LValue: string;
begin
  if (@ARecord = nil) or (ATableName = '') then
    Exit;
  LRttiContext := TRttiContext.Create;
  try
    LRttiType := LRttiContext.GetType(TypeInfo(T));
    LFields := '';
    LValues := '';
    LValue := '';
    for LRttiField in LRttiType.GetFields do
    begin
      LFields := LFields + ',' + LRttiField.Name;
      LValue :=  ProcessValue(ARecord, LRttiField);
      LValues := LValues + ',' + LValue;
    end;
    System.Delete(LFields, 1, 1);
    System.Delete(LValues, 1, 1);
    Result := 'insert into ' + ATableName + ' (' + LFields + ') values (' +
      LValues + ')';
  finally
    LRttiContext.Free;
  end;
end;

class function TRecordCrud<T>.Update(const ARecord;
  const ATableName, AKeyFields: string): string;
var
  LRttiContext: TRttiContext;
  LRttiType: TRttiType;
  LRttiField: TRttiField;
  LWhere, LValue, LSet: string;
begin
  if (@ARecord = nil) or (ATableName = '') or (AKeyFields = '') then
    Exit;
  LRttiContext := TRttiContext.Create;
  try
    LRttiType := LRttiContext.GetType(TypeInfo(T));
    LValue := '';
    LWhere := '';
    LSet := '';
    for LRttiField in LRttiType.GetFields do
    begin
      LValue :=  ProcessValue(ARecord, LRttiField);
      LSet := LSet + ',' + LRttiField.Name + '=' + LValue;
      if Pos(LRttiField.Name, AKeyFields) = 0 then
        Continue;
      LWhere := LWhere + ' and ' + LRttiField.Name + '=' + LValue;
    end;
    System.Delete(LWhere, 1, 5);
    System.Delete(LSet, 1, 1);
    Result := 'update ' + ATableName + ' set ' + LSet + ' where ' + LWhere;
  finally
    LRttiContext.Free;
  end;
end;

end.