2015-04-09 4 views
2

Я использую Delphi XE, я следующий код для моей программы и DLL:Проблемы получения данных в формате JSON из DLL с помощью надобъекта и OmniThreadLibrary

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 я получаю следующую ошибку:
«Project test_OTL_SO.exe поднял класс исключений EAccessViolation с сообщением« Нарушение доступа по адресу 005A2F8A в модуле «my.dll». Адресная s 00610754 '. "
Однако эта проблема не возникает, когда я использую ту же функцию локального GetJSON_local
Можно ли предположить, что я делаю неправильно здесь

EDIT:.? (раствор)

Я пишу это код для моей 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; 
+0

Не ваша проблема, но вам нужно прекратить использование StrPas. Он устарел в течение многих веков. 'sl.Text: = AData' –

+0

Не может быть проблема с подсчетом ссылок интерфейса (ISuperObject)? Он может быть освобожден, и поэтому появляется нарушение прав доступа ... – smooty86

+0

@David Heffernan Проблема по-прежнему сохраняется даже после удаления StrPas. – LuFang

ответ

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 в текст и передать этот текст между вашими модулями.

+0

Я обновил свой первый пост. Поэтому у меня есть код, который работает нормально. Правильно ли этот код? Я не совсем уверен в использовании WideString ... – LuFang

+0

Этот код идеален. WideString - это COM BSTR, предназначенный для совместного использования модулей. –

+0

Спасибо, ваш ответ помог мне исправить ошибку. Ценю вашу помощь! – LuFang

 Смежные вопросы

  • Нет связанных вопросов^_^