Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Общие вопросы Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 03.10.2009, 12:48   #1
bug
 
Регистрация: 03.10.2009
Сообщений: 7
По умолчанию Извлечение данных из потока

Всем доброго времени суток!!!
Возникла проблема с которой никак не могу справиться.
Проблема в следующем: Есть стороннее приложение, для него я написал dll для рассчета статистики. Обсчет очень тяжелый, по этой причине я запихнул его в поток. Все работает нормально, кроме одного. Из этого потока я никак не могу извлечь результаты вычисленй. В потоке все обсчитывается правильно, а результаты возвращает в виде 0.

(Я только начинающий форумчанин, по-этому прошу модераторов не отрываться на мне.)
bug вне форума Ответить с цитированием
Старый 03.10.2009, 13:05   #2
Daramant
Форумчанин
 
Регистрация: 06.01.2009
Сообщений: 340
По умолчанию

Как происходит передача данных dll, как пытаетесь получить данные обратно?
Приведите части кода где это происходит. Тогда можно будет говорить предметнее.
Истинный успех – это то, что Вы сделали в сравнении с тем, что могли бы сделать.
Никогда не бойся делать то, что ты не умеешь. Помни, ковчег был построен любителем. Профессионалы построили "Титаник".
Daramant вне форума Ответить с цитированием
Старый 03.10.2009, 16:56   #3
bug
 
Регистрация: 03.10.2009
Сообщений: 7
По умолчанию

Цитата:
Сообщение от Daramant Посмотреть сообщение
Как происходит передача данных dll, как пытаетесь получить данные обратно?
Приведите части кода где это происходит. Тогда можно будет говорить предметнее.
Вот исходник dll:

Код:
unit MainUnit;

interface

uses
  Windows, SysUtils, Classes, DINIUnit, DMLPUnit, DSOMUnit, DLLType;

type
  TWRInput = array[0..99] of real;
  TTool = array[0..1] of Integer;

type
  TDLLThread = class(TThread)
  private
    FCurPeriod: Integer;
    FCurTool: Integer;
    FDINI: TDINI;
    FDMLP: TDMLP;
    FDSOM: TDSOM;
    FISLoad: Boolean;
    FThreadInput: TWRInput;
    FThreadOut: Real;
    FTool: TTool;
    procedure SetThreadInput(const Value: TWRInput);
    procedure SetThreadOut(const Value: Real);
    procedure SetTool(const Value: TTool);
  public
    constructor Create(CreateSuspended: Boolean);
    destructor Destroy; override;
    procedure Execute; override;
    property FXTool: TTool read FTool write SetTool;
    property ThreadInput: TWRInput read FThreadInput write SetThreadInput;
    property ThreadOut: Real read FThreadOut write SetThreadOut;
  end;

procedure DeInitLib;

procedure InitLib;

function NetCore(Tool: TTool; Val: TWRInput): Double; stdcall;

function X2Wrapper(RowCnt, ColCnt: Cardinal; Value: TWRInput): TSOMInput;

exports
  NetCore;

var
  DLLThread: TDLLThread;

implementation

function NetCore(Tool: TTool; Val: TWRInput): Double;
begin
  DLLThread.FXTool:= Tool;
  DLLThread.ThreadInput:=Val;
  DLLThread.Resume;
  Result:= DLLThread.ThreadOut;
  DLLThread.Suspend;
end;

procedure InitLib;
begin
  DLLThread:= TDLLThread.Create(true);
  DLLThread.FreeOnTerminate:= false;
end;

procedure DeInitLib;
begin
  DLLThread.Terminate;
end;

constructor TDLLThread.Create(CreateSuspended: Boolean);
var
  Handle: THandle;
  NetPath: string;
  pos,
  dlen: Integer;
begin
  inherited Create(CreateSuspended);
    begin
      FDSOM:= TDSOM.Create;
      FDSOM.InpRow:= 10;
      FDSOM.InpCol:= 10;
      FDSOM.Clasters:=20;
      FDSOM.Normalize:= true;
      FDSOM.InitBuffers;
 
      FDMLP:= TDMLP.Create;
      FDMLP.InpDim:= 20;
      FDMLP.LayersCnt:=2;
      FDMLP.Neurons[0]:=100;
      FDMLP.Neurons[1]:=1;
      FDMLP.Normalize:= true;
      FDMLP.InitBuffers;
    
      Handle:= GetModuleHandle('Pegasus.dll');
      NetPath:= GetModuleName(Handle);
      pos:= Length(NetPath)-Length('Pegasus.dll');
      dlen:= StrLen('Pegasus.dll')+1;
      Delete(NetPath,pos,dlen);
      FDINI:= TDINI.Create(NetPath+'\Pegasus.ini');
    end;
end;

destructor TDLLThread.Destroy;
begin
  FDSOM.Free;
  FDMLP.Free;
  FDINI.Free;
  inherited Destroy;
end;

procedure TDLLThread.Execute;
begin
  inherited;
  if (FCurTool=FTool[0]) and (FCurPeriod=FTool[1]) then FISLoad:= false
  else
    begin
      FCurTool:= FTool[0];
      FCurPeriod:= FTool[1];
      FisLoad:= true;
    end;
  if (FDINI.IsAccess(FTool[0],FTool[1])=true) and (FISLoad=true) then
    begin
      FDSOM.NBPath:= FDINI.NetBasePath(FTool[0],FTool[1]);
      FDSOM.LoadFromStream;
      FDMLP.NBPath:= FDINI.NetBasePath(FTool[0],FTool[1]);
      FDMLP.LoadFromStream;
      FISLoad:= false;
    end;
    FDSOM.SOMInput:= X2Wrapper(10,10,FThreadInput);
    FDMLP.Input:= FDSOM.SOMOut;
    FDMLP.Compute;
    FThreadOut:= FDMLP.Result;
end;

procedure TDLLThread.SetThreadInput(const Value: TWRInput);
begin
  FThreadInput := Value;
end;

procedure TDLLThread.SetThreadOut(const Value: Real);
begin
  FThreadOut := Value;
end;

procedure TDLLThread.SetTool(const Value: TTool);
begin
  FTool := Value;
end;

function X2Wrapper(RowCnt, ColCnt: Cardinal; Value: TWRInput):
    TSOMInput;
var
  I,
  Row,
  Col: Cardinal;
  InBuf: TWRInput;
  OutBuf: TSOMInput;
begin
  InBuf:= Value;
  SetLength(OutBuf,RowCnt);
  for Row := 0 to RowCnt - 1 do
    SetLength(OutBuf[Row],ColCnt);
  I:= 0;
  for Row := 0 to RowCnt - 1 do
    for Col := 0 to ColCnt - 1 do
      begin
        OutBuf[Row,Col]:= InBuf[I];
        I:= I+1;
      end;
  Result:= OutBuf;
end;

end.

Последний раз редактировалось Stilet; 05.10.2009 в 10:04.
bug вне форума Ответить с цитированием
Старый 03.10.2009, 17:41   #4
Daramant
Форумчанин
 
Регистрация: 06.01.2009
Сообщений: 340
По умолчанию

Цитата:
Все работает нормально, кроме одного. Из этого потока я никак не могу извлечь результаты вычисленй.
Как вы проверяли, что расчет происходит правильно и там действительно получается верный результат, запускали вычисления из основного потока?

Запустить данный код не могу, нет некоторых модулей, но думаю проблема здесь:
Код:
function NetCore(Tool: TTool; Val: TWRInput): Double;
begin
DLLThread.FXTool:= Tool;
DLLThread.ThreadInput:=Val;
DLLThread.Resume;
Result:= DLLThread.ThreadOut;
DLLThread.Suspend;
end;
Вы запускаете поток DLLThread.Resume; и недожадаясь его завершения
пытаетесь получить результат Result:= DLLThread.ThreadOut;
Если вычисления занимают некоторое время, то при выполнении данного кода (Result:= DLLThread.ThreadOut результат еще не определен.

Т.е. необходимо сделать так:
DLLThread.Resume;
// подождать завершения потока
Result:= DLLThread.ThreadOut;

Для синхронизации можно использовать семафоры:
Попробуйте так:
Код:
uses
  syncobjs;                 { <<<<<<<<<<<< }
TDLLThread = class(TThread)
private
...
FSemaphore: THandle;                { <<<<<<<<<<<< }
...
Код:
function NetCore(Tool: TTool; Val: TWRInput): Double;
begin
DLLThread.FXTool:= Tool;
DLLThread.ThreadInput:=Val;
FSemaphore := CreateSemaphore(nil, 0, 1, nil); { <<<<<<<<<< }
DLLThread.Resume;
WaitForSingleObject(FSemaphore, INFINITE); { <<<<<<<<<<<< }
Result:= DLLThread.ThreadOut;
CloseHandle(FSemaphore);  { <<<<<<<<<<<<< }
end;

procedure TDLLThread.Execute;
begin
inherited;
...
// в конце
ReleaseSemaphore(FSemaphore, 1, nil);  { <<<<<<<<<<<<<<< }
end;
Код не компилировал, если что не так пишите, исправлю.
Истинный успех – это то, что Вы сделали в сравнении с тем, что могли бы сделать.
Никогда не бойся делать то, что ты не умеешь. Помни, ковчег был построен любителем. Профессионалы построили "Титаник".
Daramant вне форума Ответить с цитированием
Старый 03.10.2009, 17:56   #5
bug
 
Регистрация: 03.10.2009
Сообщений: 7
По умолчанию

Я эмулировал родительский поток, сделал трассировку dll.
Проводил параллельное вычисление в эмулирующем родительском потоке и dll. Результаты были идентичны в родительском потоке и потоке dll.

Идентичные до выхода из потока dll. В родительском приложении я данные скидывал в Файл.

Последний раз редактировалось Stilet; 05.10.2009 в 10:07.
bug вне форума Ответить с цитированием
Старый 03.10.2009, 18:28   #6
Daramant
Форумчанин
 
Регистрация: 06.01.2009
Сообщений: 340
По умолчанию

Цитата:
Идентичные до выхода из потока dll.
Если так, тогда скажите, после выполнения какого оператора данные пропадают. (Добавьте переменную, содержащую данные в Watch (Run -> Add Watch) и оттрасируйте программу)
Данные пропадают в NetCore или при выходе из dll в основную программу?
Т.е. именно массивы имеют 0 значения, т.е. исключений нет?
Попробуйте скинуть данные в файл из потока.
Истинный успех – это то, что Вы сделали в сравнении с тем, что могли бы сделать.
Никогда не бойся делать то, что ты не умеешь. Помни, ковчег был построен любителем. Профессионалы построили "Титаник".

Последний раз редактировалось Daramant; 03.10.2009 в 18:33.
Daramant вне форума Ответить с цитированием
Старый 03.10.2009, 18:58   #7
bug
 
Регистрация: 03.10.2009
Сообщений: 7
По умолчанию

Данные пропадают при выходе из потока. Вот здесь их уже нет.
Result:= DLLThread.ThreadOut;
Думаю да, все дело в том что программа не дожидается звершения потока.
bug вне форума Ответить с цитированием
Старый 03.10.2009, 19:05   #8
Daramant
Форумчанин
 
Регистрация: 06.01.2009
Сообщений: 340
По умолчанию

Код:
FDSOM.SOMInput:= X2Wrapper(10,10,FThreadInput);
FDMLP.Input:= FDSOM.SOMOut;
FDMLP.Compute;
Т.е. данный код выполняется нормально и данные передаются в FDMLP.Input?
Цитата:
Думаю да, все дело в том что программа не дожидается звершения потока.
Тогда все таки попробуйте добавить семафор.
Истинный успех – это то, что Вы сделали в сравнении с тем, что могли бы сделать.
Никогда не бойся делать то, что ты не умеешь. Помни, ковчег был построен любителем. Профессионалы построили "Титаник".
Daramant вне форума Ответить с цитированием
Старый 05.10.2009, 08:42   #9
bug
 
Регистрация: 03.10.2009
Сообщений: 7
По умолчанию

Семафор не помог.
Чтобы быть абсолютно уверенным, что мы говорим об одном и том-же я сделал упрщенную копию проекта.
Моудль dll:

Код:
unit MainUnit;

interface

uses
  Windows,
  SysUtils,
  Classes;

type
  TDLLThread = class(TThread)
  protected
  public
    procedure Execute; override;
  end;

function Sum(NewParam1, NewParam2: Real): Real; stdcall;

exports
  Sum;

var
  Rez: Real;
  Param1,
  Param2: Real;
  hMutex: THandle=0;

implementation

function Sum(NewParam1, NewParam2: Real): Real;
var
  DLLThread: TDLLThread;
begin
  Param1:= NewParam1;
  Param2:= NewParam2;
  hMutex := CreateMutex(nil, False, nil);
  DLLThread:= TDLLThread.Create(false);
  DLLThread.FreeOnTerminate:= true;
  DLLThread.Resume;
  Result:= Rez;
  CloseHandle(hMutex);
end;

procedure TDLLThread.Execute;
begin
  inherited;
  if WaitForSingleObject(hMutex, INFINITE) = WAIT_OBJECT_0 then
    Rez:= Param1+Param2;
  Sleep(5);
  ReleaseMutex(hMutex);
end;

end.
//*********************************** *********************
Выщывающий exe
//*********************************** *********************

Код:
unit MainForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

function Sum(NewParam1, NewParam2: Real): Real; stdcall; external 'TestDll.dll';

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  Val1,Val2, Rez: Real;
begin
  Val1:= StrToFloat(Form1.Edit1.Text);
  Val2:= StrToFloat(Form1.Edit2.Text);
  Rez:= Sum(Val1, Val2);
  Form1.Edit3.Text:= FloatToStr(Rez);
end;

end.
//*********************************** *********************
Хрень абсолютно таже самая. Из потока данные не выбираются.

Последний раз редактировалось Stilet; 05.10.2009 в 10:07.
bug вне форума Ответить с цитированием
Старый 05.10.2009, 12:37   #10
bug
 
Регистрация: 03.10.2009
Сообщений: 7
По умолчанию

Разобрался, все работает. Благодарю.
bug вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Извлечение значений из БД? ITM Microsoft Office Excel 4 10.01.2009 23:40
Access извлечение данных из строки Melamory Microsoft Office Access 3 28.09.2008 19:50
Извлечение данных из TCppWebBrowser НикСерг Общие вопросы C/C++ 1 13.07.2008 17:16
Безопасное извлечение SunKnight Win Api 1 12.01.2008 02:06