2

我正在使用 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，并显示消息‘模块‘my.dll’中地址 005A2F8A 的访问冲突。写入地址 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;
4

1 回答 1

2

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 序列化为文本，并在模块之间传递该文本。

于 2015-04-09T15:05:17.493 回答