Delphi Can

Delphi 12.1 içinde mevcut Json Data Binding ile olusturdugum class uniti ile beraber parse mükemmel çalışmakta, ama yeni bir json oluşturma aşamasında json içindeki array içeren kısma veri atama bende sorun oluşturdu. Daha önce xml data binding de kullandığım için böyle bir durumda object in .add özelliği ile yeni bir item ataması yapılabilirken json data binding ile oluşan class içinde bu yok. Class ile çalışırken array içine yeni bir item nasıl ekleneceği konusunda embarcadero da ve samples da örnek bulamadım. aşagıda sıarsıyla örnek json olusturulan class ve yazdığım json parse ve yeni oluşturma programlarını veriyorum

Kod:

{

    "info": {

        "_postman_id": "a4f441c6-1e46-4660-abe9",

        "name": "Control",

        "schema": "https://schema.getpostman.com/json/collection/v2.0.0/collection.json",

        "_exporter_id": "99603775"

    },

    "item": [

        {

            "name": "Request",

            "request": {

                "method": "POST",

                "header": [],

                "body": {

                    "mode": "raw",

                    "raw": "{\r\n    \"clientInformation\",

                    "options": {

                        "raw": {

                            "language": "json"

                        }

                    }

                },

                "url": "https://ControlService/Control"

            },

            "response": []

        }

    ]

}

// This unit is autogenerated. Do not edit it manually.
// Source: JSON entered in editor
// Date: 16.05.2024 04:20:08

unit PostGateJson;

interface

uses
 System.Classes, REST.Json.Types;

type
 [JsonSerialize(jmAllPubProps)]
 TRaw = class(TPersistent)
 private
   Flanguage: string;
 public
   property language: string read Flanguage write Flanguage;
 end;

 [JsonSerialize(jmAllPubProps)]
 TOptions = class(TPersistent)
 private
   Fraw: TRaw;
 public
   constructor Create;
   destructor Destroy; override;
   property raw: TRaw read Fraw;
 end;

 [JsonSerialize(jmAllPubProps)]
 TBody = class(TPersistent)
 private
   Fmode: string;
   Fraw: string;
   Foptions: TOptions;
 public
   constructor Create;
   destructor Destroy; override;
   property mode: string read Fmode write Fmode;
   property raw: string read Fraw write Fraw;
   property options: TOptions read Foptions;
 end;

 [JsonSerialize(jmAllPubProps)]
 TRequest = class(TPersistent)
 private
   Fmethod: string;
   Fheader: TArray<string>;
   Fbody: TBody;
   Furl: string;
 public
   constructor Create;
   destructor Destroy; override;
   property method: string read Fmethod write Fmethod;
   property header: TArray<string> read Fheader write Fheader;
   property body: TBody read Fbody;
   property url: string read Furl write Furl;
 end;

 [JsonSerialize(jmAllPubProps)]
 TInfo = class(TPersistent)
 private
   F_postman_id: string;
   Fname: string;
   Fschema: string;
   F_exporter_id: string;
 public
   property _postman_id: string read F_postman_id write F_postman_id;
   property name: string read Fname write Fname;
   property schema: string read Fschema write Fschema;
   property _exporter_id: string read F_exporter_id write F_exporter_id;
 end;

 [JsonSerialize(jmAllPubProps)]
 TItem = class(TPersistent)
 private
   Fname: string;
   Frequest: TRequest;
   Fresponse: TArray<string>;
 public
   constructor Create;
   destructor Destroy; override;
   property name: string read Fname write Fname;
   property request: TRequest read Frequest;
   property response: TArray<string> read Fresponse write Fresponse;
 end;

 [JsonSerialize(jmAllPubProps)]
 TPostGate = class(TPersistent)
 private
   Finfo: TInfo;
   Fitem: TArray<TItem>;
 public
   constructor Create;
   destructor Destroy; override;
   property info: TInfo read Finfo;
   property item: TArray<TItem> read Fitem write Fitem;
 end;

implementation

uses
 System.SysUtils, System.Generics.Collections;

constructor TOptions.Create;
begin
 inherited Create;
 Fraw := TRaw.Create;
end;

destructor TOptions.Destroy;
begin
 FreeAndNil(Fraw);
 inherited Destroy;
end;

constructor TBody.Create;
begin
 inherited Create;
 Foptions := TOptions.Create;
end;

destructor TBody.Destroy;
begin
 FreeAndNil(Foptions);
 inherited Destroy;
end;

constructor TRequest.Create;
begin
 inherited Create;
 Fbody := TBody.Create;
end;

destructor TRequest.Destroy;
begin
 TArray.FreeValues<string>(Fheader);
 FreeAndNil(Fbody);
 inherited Destroy;
end;

constructor TItem.Create;
begin
 inherited Create;
 Frequest := TRequest.Create;
end;

destructor TItem.Destroy;
begin
 FreeAndNil(Frequest);
 TArray.FreeValues<string>(Fresponse);
 inherited Destroy;
end;

constructor TPostGate.Create;
begin
 inherited Create;
 Finfo := TInfo.Create;
end;

destructor TPostGate.Destroy;
begin
 FreeAndNil(Finfo);
 TArray.FreeValues<TItem>(Fitem);
 inherited Destroy;
end;

initialization

 RegisterClass(TRaw);
 RegisterClass(TOptions);
 RegisterClass(TBody);
 RegisterClass(TRequest);
 RegisterClass(TInfo);
 RegisterClass(TItem);
 RegisterClass(TPostGate);

end.

ve benim yazdığım program da soyle

procedure TForm1.AcClick(Sender: TObject);
var
   openfile : Topendialog;
   FileName : string;
   json     : string;
   x        : integer;
   file_bytes : Tbytes;
   file_str : string;
   Ldata    : TPostGate;


begin
  openfile:=topendialog.Create(self);

  try

     if openfile.Execute then begin
       FileName:=openfile.Files.Text;
     end else exit;

     filename:=trim(filename);

     memo1.Lines.Add(filename);

     file_bytes:=TFile.ReadAllBytes(filename);
     file_str:=tencoding.utf8.GetString(file_bytes);

     Ldata:=TPostGate.Create;

    // TJSONMapper<TPostgate>.SetDefaultLibrary('REST.Json');

     //Ldata:=TJson.JsonToObject<T>(file_str);
     Ldata:=TJSONMapper<TPostgate>.Default.FromObject(file_str);

     memo1.Lines.Add(file_str);

     memo2.Lines.Add('info exporter id '+Ldata.Info._exporter_id);
     memo2.Lines.Add('info name        '+Ldata.Info.Name);
     memo2.Lines.Add('info postman id  '+Ldata.Info._postman_id);
     memo2.Lines.Add('item raw count   '+length(Ldata.item).ToString);
     for x := 0 to length(Ldata.Item)-1 do begin
       memo2.Lines.Add('item name        '+Ldata.Item[x].Name);
       memo2.Lines.Add('item raw         '+Ldata.Item[x].request.body.raw);
       memo2.Lines.Add('item Bitti       ');
     end;
  finally
    freeandnil(openfile);
    freeandnil(ldata);
  end;


end;





procedure TForm1.yeniClick(Sender: TObject);
var
   Ldata    : TPostGate;
   s        : string;
   x : integer;
   item     : Titem;
begin

  try
      try

         Ldata:=TPostGate.Create;
         ldata.info._postman_id:='989878-858458-';
         ldata.info.name:='Mahmut POst';
         ldata.info.schema:='https://schema.getpostman.com/json/collection/v2.0.0/collection.json';
         ldata.info._exporter_id:='28803297xx';

         item:=Titem.Create; ///   ?????? bu sekilde calsır fakat item Ldata ya eklenmez

         item.name:='Request';
         item.request.method :='POST';
         item.request.body.mode :='RAW';
         item.request.body.raw  :='{\r\n    \"clientInformation\":';
         item.request.body.options.raw.language:='json';
         item.request.url:='https://Mahmut';

         s := TJSONMapper<TPostGate>.Default.ToString(LData);

         memo1.Lines.Add(s);

      except on e:exception do begin
           showmessage('error '+e.Message);
           e.CleanupInstance;
        end;
      end;
  finally
   freeandnil( ldata);
  end;


end;

Ornek json da gorulduğu gibi Item etiketi altındakiler array olarak tanımlı, bircok deneme yaptım ama buradaki Array olan Item kısmına veri eklemek için nasıl bir yol kullanacağımı bulamadım.
array olan Item kısmı harıc yeni json olusuyor.
ilgilenen arkadaşlara simdiden tesekkür ederim iyi gunler dilerim.

SetLength(Ldata.Item, Length(Ldata.Item)+1);
Ldata.Item[High(Ldata.Item)] := item;

Merhaba öncelikle ilginiz için tesekkür ederim
Ben onu denedim
Setlength ile eleman ataması yapmak isteyince

SetLength(Ldata.Item, Length(Ldata.Item)+1);

[dcc32 Error] Unit1.pas(113): E2197 Constant object cannot be passed as var parameter
hatası veriyor

onu kaldırıp sadece
Ldata.Item[High(Ldata.Item)] := item;

kullanmaya kalkarsanız da range error
onun için de R- direktifi verirseniz runtime da access voilation hatası alıyorsunuz

cunku olmayan dizi elemanına atama yapmaya kalkıyoruz.

json data bindig ile olusturlan class içinde belki bir sey yapılabilirmi diye baktım ama ben beceremedim
bence class içindeki fonsiyonlarında add olmalı gibi düşünüyorum
yani ayni xml data binding in olusturduğu gibi
Ldata.İtem.add
ile array içine önce yeni bir eleman konmalı diye düşünüyorum.

Benim görmediğim veya bilmediğim baska bir sey varsa onu da öğretecek arkadaşa simdiden tesekkür ederim. iyi günler iyi çalısmalar dilerim.

Muhtemelen Ldata.Item property olduğu için bu işlemi yapmaya izin vermiyor. Bunu aşmak için TPostGate sınıfı içine bir fonksiyon yazın ve bu fonksiyon sizin istediğiniz işlemi yapsın. Fonksiyon ile işlemleri Item ile değil Fitem ile yapın.

[JsonSerialize(jmAllPubProps)]
TPostGate = class(TPersistent)
private
  Finfo: TInfo;
  Fitem: TArray<TItem>;
public
  constructor Create;
  destructor Destroy; override;
  property info: TInfo read Finfo;
  property item: TArray<TItem> read Fitem write Fitem;

  function AddItem(AItem: TItem): Boolean;  //Burayı ekledik.
end;

//eklenen fonksiyonun içeriği burası
function TPostGate.AddItem(AItem: TItem): Boolean;
begin
 Result := True;
 try
   SetLength(Self.FItem, Length(Self.FItem)+1);
   Self.FItem[High(Self.Item)] := AItem;
 except
   Result := False;
 end;
end;

//Kullanımı burada
if (Ldata.AddItem(item)) then
  ShowMessage('Ekleme başarılı');

Bunun için rahatlıkla record helper kullanabilirsiniz.

Sizin için bir tanesini record helper'a çevirdim; gereken diğerlerini siz çevirirsiniz:

  
 TItems = TArray<TItem>;

 TItemsHelper = record helper for TItems
 public
   function Add : TItem; overload;
   procedure Add(const AItem : TItem); overload;

   procedure Remove(const AItem : TItem);
 end;

{ TItemsHelper }

function TItemsHelper.Add: TItem;
begin
 Result := TItem.Create;

 Add(Result);
end;

procedure TItemsHelper.Add(const AItem: TItem);
begin
 SetLength(Self, Length(Self) + 1);

 Self[High(Self)] := AItem;
end;

procedure TItemsHelper.Remove(const AItem: TItem);
var
 AList : TList<TItem>;
begin
 AList := TList<TItem>.Create(Self);

 try
   if AList.Contains(AItem) then
   begin
     AList.Remove(AItem);

     AItem.Free;
   end; // if AList.Contains(AItem) then

   Self := AList.ToArray;
 finally
   if Assigned(AList) then
     FreeAndNil(AList);
 end; // try..finally
end;

İlgili sınıflarınızda TArray<TItem> olarak geçen kısmı; TItems olarak değiştirirseniz daha rahat bir kullanımınız olacaktır.

aegean

SimaWB

aegean

3ddark

Tuğrul HELVACI