странное поведение TJSONObject в fpjson

Вопросы программирования и использования среды Lazarus.

Модератор: Модераторы

странное поведение TJSONObject в fpjson

Сообщение ssnakess » 19.07.2023 21:45:46

Cделал наследника от TIdHTTP, добавил несколько методов класса, для работы с json

Код: Выделить всё
....
function THTTPSender.StringToJSON(src: String): TJSONObject;
var JsonParser: TJSONParser;
      jo: TJSONObject;
begin
  result:=nil;
  if src<>'' then
  Begin
    try
     try
      JsonParser:=TJSONParser.Create(src);
      jo:=JsonParser.Parse as TJSONObject;
      result:=jo;
      Addlog('result StringToJSON: '+jo.AsJSON);
     except
       on E:Exception do Addlog('!!! Exception [StringToJSON]: '+E.Message);
     end;
    finally
      JsonParser.free;
    end;
  end;
end;

function THTTPSender.JSONToString(src: TJSONObject): String;
begin
  try
   result:='';
   if src<>nil Then
    begin
      src.FormatJSON(AsCompressedJSON,2);
      result:=src.AsJSON;
    end;
   Addlog('result JsonToString: '+result);
  except
     on E:Exception do
      Begin
           Addlog('!!! Exception [JSONToString]: '+E.Message);
           result:='';
      end;
  end;
end;

function THTTPSender.Send(Data: TJSONObject): boolean;
begin
AddLog('send json');
ClearSendData;
if Data<>nil then
   Begin
      fJSONData:=StringToJSON(JSONToString(Data));
      AddLog('send data: '+fJSONData.AsJSON);
   end
else AddLog('send data: nil');
result:=Post;  // передача данных методом post
end;

....


Всё работает, но периодически. клинит, и при каждом вызове метода send( ) получаю "странное" преобразование от слова совсем странное.
По логам смотрю и из вполне нормального переданного в Data объекта json
{ "type" : "request_data", "sn" : 1646021 }
получаю вот это
result JsonToString: type"request_data"sn1646021

т.е. хоть стреляй, но если хоть раз его так переклинило, то все остальные вызовы метода send преобразуют json в такое вот безобразие, хоть какой json передай
ssnakess
новенький
 
Сообщения: 47
Зарегистрирован: 24.09.2011 23:08:55

Re: странное поведение TJSONObject в fpjson

Сообщение ssnakess » 21.07.2023 09:37:18

вдруг кому пригодится :)

вот так надо делать, и тогда можно получить строку из TJSONObject, в нормальном виде - всегда
Код: Выделить всё
function THTTPSender.JSONToString(src: TJSONObject): String;
var s;TStringStream;
begin
  try
   result:='';
   if src<>nil Then
    begin
      s:=TStrngStream.Create;
      src.DumpJSON(s);
      result:=s.DataString;
      s.Free;
    end;
   Addlog('result JsonToString: '+result);
  except
     on E:Exception do
      Begin
           Addlog('!!! Exception [JSONToString]: '+E.Message);
           result:='';
      end;
  end;
end;
ssnakess
новенький
 
Сообщения: 47
Зарегистрирован: 24.09.2011 23:08:55

Re: странное поведение TJSONObject в fpjson

Сообщение iskander » 21.07.2023 11:40:50

ssnakess писал(а):...
Код: Выделить всё
...
function THTTPSender.JSONToString(src: TJSONObject): String;
begin
  try
   result:='';
   if src<>nil Then
    begin
      src.FormatJSON(AsCompressedJSON,2);
      result:=src.AsJSON;
    end;
   Addlog('result JsonToString: '+result);
  except
     on E:Exception do
      Begin
           Addlog('!!! Exception [JSONToString]: '+E.Message);
           result:='';
      end;
  end;
end;
...

...

Имхо строка src.FormatJSON(AsCompressedJSON,2); тут лишняя.

ssnakess писал(а):вот так надо делать, и тогда можно получить строку из TJSONObject, в нормальном виде - всегда

А AsJson и FormatJson() не всегда?
Кмк DumpJson() нужен больше из соображений производительности, поскольку AsJson и FormatJson() изрядно тормозные.
iskander
энтузиаст
 
Сообщения: 627
Зарегистрирован: 08.01.2012 18:43:34

Re: странное поведение TJSONObject в fpjson

Сообщение Alex2013 » 12.12.2025 15:22:13

Довольно быстрая кодировка картинки в код Base64 (аналог UUE) (и обратная раскодировка)
Может кому-то пригодится например в TJSONObject из fpjson битмап вставить и достать . ( именно так использую )

( Сначала писал Дип Сек (не работало ) потом я (заработало но медленно) потом снова Дип Сек ( который оптимизировал мои каракули ) )
Требуется подключить модуль " Base64".
Код: Выделить всё
function ImageToBase64(Bitmap: TBitmap): String;
var
  Input: TMemoryStream;
  Output: TStringStream;
  Encoder: TBase64EncodingStream;
begin
  Result := '';
  if (Bitmap = nil) or Bitmap.Empty then Exit;
 
  Input := TMemoryStream.Create;
  try
    // Сохраняем в PNG для лучшего сжатия (или BMP для простоты)
    Bitmap.SaveToStream(Input);
    Input.Position := 0;
   
    Output := TStringStream.Create('');
    try
      Encoder := TBase64EncodingStream.Create(Output);
      try
        Encoder.CopyFrom(Input, Input.Size);
      finally
        Encoder.Free;
      end;
      Result := Output.DataString;
    finally
      Output.Free;
    end;
  finally
    Input.Free;
  end;
end;


Код: Выделить всё
function Base64ToImage(const Base64Str: String): TBitmap;
var
  Input: TStringStream;
  Output: TMemoryStream;
  Decoder: TBase64DecodingStream;
begin
  Result := TBitmap.Create;
 
  if Base64Str = '' then
  begin
    Result.Width := 100;
    Result.Height := 100;
    Result.Canvas.Brush.Color := clWhite;
    Result.Canvas.FillRect(0, 0, 100, 100);
    Result.Canvas.TextOut(10, 40, 'No image');
    Exit;
  end;
 
  Input := TStringStream.Create(Base64Str);
  try
    Output := TMemoryStream.Create;
    try
      Decoder := TBase64DecodingStream.Create(Input, bdmMIME);
      try
        Output.CopyFrom(Decoder, Decoder.Size);
        Output.Position := 0;
       
        try
          Result.LoadFromStream(Output);
        except
          Result.Width := 100;
          Result.Height := 100;
          Result.Canvas.Brush.Color := clRed;
          Result.Canvas.FillRect(0, 0, 100, 100);
          Result.Canvas.TextOut(10, 40, 'Load error');
        end;
      finally
        Decoder.Free;
      end;
    finally
      Output.Free;
    end;
  finally
    Input.Free;
  end;
end;
Alex2013
долгожитель
 
Сообщения: 3207
Зарегистрирован: 03.04.2013 11:59:44


Вернуться в Lazarus

Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 1