mORMot Open Source

  TSQLProduct = class(TSQLRecord)
  private
    fPreview: TSQLRawBlob;
  public
  published
    property preview: TSQLRawBlob read fPreview write fPreview;
  end;

var
  Form1: TForm1;
  Database: TSQLRestClientURI;
  Server: TSQLRestServerDB;
  model: TSQLModel;

implementation

{$R *.dfm}

function CreateModel: TSQLModel;
begin
  result := TSQLModel.Create([TSQLProduct]);
end;

procedure InitClient;
begin
  Model := CreateModel;
  Database := TSQLRestClientDB.Create(Model, CreateModel, 'test.db3', TSQLRestServerDB);
  if Database = nil then Exit;
  DataBase.ForceBlobTransfert := True;
  TSQLRestClientDB(Database).Server.CreateMissingTables(0);
end;

procedure FinalizeClient;
begin
  Server.Free;
  Database.Free;
  Model.Free;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  i, j, c: Integer;
  jpg: TJPEGImage;
  pic: RawByteString;
  prd: TSQLProduct;
begin
  c := 0;
  for j := 1 to 1000 do begin
    for i := 1 to 1000 do begin
        prd := TSQLProduct.Create(Database, i, False);
        try
          pic := prd.preview;
          inc(c);
          Caption := IntToStr(c);
          if pic <> '' then begin
            img.Picture := nil;
            img.Picture.Assign(LoadFromRawByteString(pic));
          end;
      finally
        FreeAndNil(prd);
      end;
      Application.ProcessMessages
    end;
  end;
end;

initialization
  Gdip := TGDIPlusFull.Create;
  InitClient;
finalization
  FinalizeClient();
end.

  TSQLPerson = class(TSQLRecord)
  private
    fFam, fIm, fOt,
    fSex: string;
    fDr: TDateTime;
...
  published
    property Fam: string read fFam write fFam;
    property Im: string read fIm write fIm;
    property Ot: string read fOt write fOt;
    property Sex: String read fSex write fSex;
    property Dr: TDateTime read fDr write fDr;
...
  end;

  TSQLPatients = class(TSQLPerson)
  private
    fMO: Integer;
    fFizRazv: string;
    fMass, fRost: Real;
...
  published
    property MO: Integer read fMO write fMO;
    property FizRazv: string read fFizRazv write fFizRazv;
    property Mass: Real read fMass write fMass;
    property Rost: Real read fRost write fRost;
...
  end;

procedure TfrmMain.SetMO;
var
  i: Integer;
  patients: TSQLPatients;
  ids: TIntegerDynArray;
begin
  if TablePatients = nil then Exit;

  patients := TSQLPatients.Create;
  try
    patients.FillPrepare(TablePatients);
    if Database.TransactionBegin(TSQLPatients) then
    try
      Database.BatchStart(TSQLPatients);
      while patients.FillOne do begin
        patients.MO := MOs.ID;
        Database.BatchUpdate(patients);
      end;
      Database.BatchSend(ids);
      Database.Commit;
      ShowNotification('МО успешно обновлено');
    except
      ShowNotification('Ошибка при обновлении');
      Database.RollBack;
    end;
  finally
    FreeAndNil(patients);
  end;
end;