Проблемы с получением данных JSON из DLL с использованием SuperObject и OmniThreadLibrary

Я использую Delphi XE, у меня есть следующий код для моей программы и DLL:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, superobject,
  OtlCommon, OtlCollections, OtlParallel;

type
  TForm1 = class(TForm)
    btnStart: TButton;
    btnStop: TButton;
    procedure btnStartClick(Sender: TObject);
    procedure btnStopClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
  private
    FLogger  : IOmniBackgroundWorker;
    FPipeline: IOmniPipeline;
    FLogFile: TextFile;
  strict protected
    procedure Async_Log(const workItem: IOmniWorkItem);
    procedure Async_Files(const input, output: IOmniBlockingCollection);
    procedure Async_Parse(const input: TOmniValue; var output: TOmniValue);
    procedure Async_JSON(const input, output: IOmniBlockingCollection);
  end;

var
  Form1: TForm1;

  function GetJSON(AData: PChar): ISuperObject; stdcall; external 'my.dll';

implementation

uses OtlTask, IOUtils;

{$R *.dfm}

function GetJSON_local(AData: PChar): ISuperObject;
var
  a: ISuperObject;
  sl: TStringList;
begin
  sl := TStringList.Create;
  try
    sl.Text := StrPas(AData);

    Result := SO();
    Result.O['array'] := SA([]);

    a := SO;
    a.S['item1'] := sl[14];
    Result.A['array'].Add(a);

    a := nil;
    a := SO;
    a.S['item2'] := sl[15];
    Result.A['array'].Add(a);

  finally
    sl.Free;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  s: string;
begin
  // log
  s := ExtractFilePath(Application.ExeName) + 'Logs';
  if not TDirectory.Exists(s) then TDirectory.CreateDirectory(s);
  s := Format(s+'\%s.txt', [FormatDateTime('yyyy-mm-dd_hh-nn-ss', Now)]);
  AssignFile(FLogFile, s);
  Rewrite(FLogFile);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  CloseFile(FLogFile);
end;

procedure TForm1.Async_Log(const workItem: IOmniWorkItem);
begin
  WriteLn(FLogFile, workItem.Data.AsString);
end;

procedure TForm1.Async_Files(const input, output: IOmniBlockingCollection);
var
  f: string;
begin
  while not input.IsCompleted do begin
    for f in TDirectory.GetFiles(ExtractFilePath(Application.ExeName), '*.txt') do
      output.TryAdd(f); // output as FileName
    Sleep(1000);
  end;
end;

procedure TForm1.Async_Parse(const input: TOmniValue; var output: TOmniValue);
var
  sl: TStringList;
begin
  sl := TStringList.Create;
  try
    sl.LoadFromFile(input.AsString);
//    output := GetJSON_local(PChar(sl.Text)); // output as ISuperObject --- local function
    output := GetJSON(PChar(sl.Text)); // output as ISuperObject ---  DLL function
  finally
    sl.Free;
  end;

  FLogger.Schedule(FLogger.CreateWorkItem(Format('%s - File processed: %s', [DateTimeToStr(Now), input.AsString])));
end;

procedure TForm1.Async_JSON(const input, output: IOmniBlockingCollection);
var
  value: TOmniValue;
  JSON: ISuperObject;
begin
  for value in input do begin
    if value.IsException then begin
      FLogger.Schedule(FLogger.CreateWorkItem(value.AsException.Message));
      value.AsException.Free;
    end
    else begin
      JSON := value.AsInterface as ISuperObject;
      FLogger.Schedule(FLogger.CreateWorkItem(JSON.AsString));
    end;
  end;
end;

//
procedure TForm1.btnStartClick(Sender: TObject);
begin
  btnStart.Enabled := False;

  FLogger := Parallel.BackgroundWorker.NumTasks(1).Execute(Async_Log);
  FPipeline := Parallel.Pipeline
    .Stage(Async_Files)
    .Stage(Async_Parse)
    .Stage(Async_JSON)
    .Run;
end;

procedure TForm1.btnStopClick(Sender: TObject);
begin
  if Assigned(FPipeline) and Assigned(FLogger) then begin
    FPipeline.Input.CompleteAdding;
    FPipeline := nil;
    FLogger.Terminate(INFINITE);
    FLogger := nil;
  end;

  btnStart.Enabled := True;
end;

end.

// DLL code
library my;

uses
  SysUtils,
  Classes, superobject;

function GetJSON(AData: PChar): ISuperObject; stdcall;
var
  a: ISuperObject;
  sl: TStringList;
begin
  sl := TStringList.Create;
  try
    sl.Text := StrPas(AData);

    Result := SO();
    Result.O['array'] := SA([]);

    a := SO;
    a.S['item1'] := sl[14];
    Result.A['array'].Add(a);

    a := nil;
    a := SO;
    a.S['item2'] := sl[15];
    Result.A['array'].Add(a);

  finally
    sl.Free;
  end;
end;


exports
  GetJSON;

begin
end.

Когда я пытаюсь запустить с отладкой своего кода, после нескольких вызовов функции dll GetJSON я получаю следующую ошибку:
"Проект test_OTL_SO.exe поднял класс исключений EAccessViolation с сообщением" Нарушение прав доступа по адресу 005A2F8A в модуле "my.dll". Запись адреса 00610754 "."
Однако эта проблема не возникает, когда я использую ту же локальную функцию GetJSON_local.
Кто-нибудь может подсказать, что я здесь делаю не так?

РЕДАКТИРОВАТЬ: (решение)

Я пишу этот код для моей DLL:

procedure GetJSON_(const AData: PChar; out Output: WideString); stdcall;
var
  json, a: ISuperObject;
  sl: TStringList;
begin
  sl := TStringList.Create;
  try
    sl.Text := AData;

    json := SO();
    json.O['array'] := SA([]);

    a := SO;
    a.S['item1'] := sl[14];
    json.A['array'].Add(a);

    a := nil;
    a := SO;
    a.S['item2'] := sl[15];
    json.A['array'].Add(a);

    Output := json.AsString;
  finally
    sl.Free;
  end;
end;

и изменил код процедуры Async_Parse:

procedure TForm1.Async_Parse(const input: TOmniValue; var output: TOmniValue);
var
  sl: TStringList;
  ws: WideString;
begin
  sl := TStringList.Create;
  try
    sl.LoadFromFile(input.AsString);
    GetJSON_(PChar(sl.Text), ws); // DLL procedure
    output := SO(ws); // output as ISuperObject
  finally
    sl.Free;
  end;

  FLogger.Schedule(FLogger.CreateWorkItem(Format('%s - File processed: %s', [DateTimeToStr(Now), input.AsString])));
end;
Источник

1 ответ

Решение

Проблема в твоей смерти ISuperObject интерфейсы через границу модуля. Хотя интерфейсы можно безопасно использовать таким образом, методы интерфейса небезопасны. Некоторые методы интерфейса принимают или возвращают строки, объекты и т. Д. То есть типы, которые не безопасны для взаимодействия.

Некоторые примеры методов, которые не являются безопасными:

function GetEnumerator: TSuperEnumerator; // TSuperEnumerator is a class
function GetS(const path: SOString): SOString; // returns a Delphi string
function SaveTo(stream: TStream; indent: boolean = false; 
  escape: boolean = true): integer; overload; // TStream is a class
function AsArray: TSuperArray; // TSuperArray is a class
// etc.

Вы должны сериализовать JSON в текст и передавать этот текст между вашими модулями.

Источник
Другие вопросы по тегам