2

I'm using Delphi XE, I have the following code for my program and 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.

When I try to run with debugging my code, after a few calls of the dll GetJSON function i get the following error:
"Project test_OTL_SO.exe raised exception class EAccessViolation with message 'Access violation at address 005A2F8A in module 'my.dll'. Write of address 00610754'."
However, this issue does not occur when I use the same local function GetJSON_local.
Could anyone suggest what am I doing wrong here?

EDIT: (solution)

I write this code for my 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;

and changed the code of Async_Parse procedure:

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;
LuFang
  • 191
  • 3
  • 12
  • Not your problem, but you need to stop using StrPas. It's been deprecated for ages and ages. `sl.Text := AData` – David Heffernan Apr 09 '15 at 12:53
  • Can't it be a problem with the interface reference counting (ISuperObject)? It might be freed and that's why access violation appears ... – smooty86 Apr 09 '15 at 12:59
  • @David Heffernan The problem still persists even after removing StrPas. – LuFang Apr 09 '15 at 13:08
  • 1
    One more thing: can you try to pass it as parameter instead of result? procedure GetJSON(const AData: PChar; var Output: ISuperObject); stdcall; – smooty86 Apr 09 '15 at 13:12
  • @smooty86 i try it but still the same issue... – LuFang Apr 09 '15 at 13:31
  • "The problem still persists even after removing StrPas." Please read my comment again, very carefully, and note the part where I stated that StrPas is not your problem. – David Heffernan Apr 09 '15 at 13:43
  • @David Heffernan I see, sorry... – LuFang Apr 09 '15 at 13:57
  • Isn't the issue likely to be that you can't share objects between a dll and and exe and the ISuperObject interface is in fact really a reference to an object? This isn't really my area of expertise but I would like to know why I'm wrong. – Kanitatlan Apr 09 '15 at 14:01
  • @Kanitatlan You were on the right track. The interface itself is fine. It's the methods that are not. – David Heffernan Apr 09 '15 at 15:07

1 Answers1

2

The problem is your passing of ISuperObject interfaces across a module boundary. Although interfaces can be safely used that way, the methods of the interface are not safe. Some of the methods of the interface accept, or return, strings, objects, etc. That is, types that are not safe for interop.

Some examples of methods that are not safe:

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. 

You should serialize the JSON to text, and pass that text between your modules.

David Heffernan
  • 601,492
  • 42
  • 1,072
  • 1,490