VPF::Технология dll, пишет ошибку - Форум программистов

alf138

Дата 18.12.2009, 18:45 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 161
Регистрация: 15.11.2009

Репутация: нет
Всего: нет

Наgисал библиотеку dll и теперь обрасчаюсь у ней статически не могу понять в чем ошибку помогите.
Код библиотеки

Код

library Project1;

uses
  SysUtils,
  Classes;

type
  TArray = array of real;

{$R *.res}

function Interval(Y: TArray; a, b: real): TArray; stdcall;
var
  i,k: integer;
begin
  k := 0;
  for i := 0 to length(Y) do
  begin
    if (Y[i] >= a) and (Y[i] <= b) then k := k + 1; //размерность нового массива
  end;
  SetLength(Result,k);   //устанавливаем размерность
  k := 0;                //индекс
  for i := 0 to length(Y) do
  begin
    if (Y[i] >= a) and (Y[i] <= b) then
    begin
      Result[k] := Y[i]; //записываем числа принадлежащие интервалу [a,b]
      k := k + 1;
    end;
  end;
end;

function MaxElement(Z: TArray): real; stdcall;
var
  i: integer;
  k: real;
begin
  k := Z[1]; 
  for i := 1 to length(Z) - 1 do
  begin
    if k < Z[i] then k := Z[i];
  end;
  Result := k;
end;

function Negativ(X: TArray): TArray; stdcall;
var
  i,k: integer;
begin
  k := 0;
  for i := 0 to length(X) - 1 do
  begin
    if X[i] < 0 then k := k + 1;   //размерность нового массива
  end;
  SetLength(Result,k);    //устанавливаем размерность массива
  k := 0;
  for i := 0 to length(X) - 1 do
  begin
    if X[i] < 0 then
    begin
      Result[k] := X[i];  //записываем только отрицательные числа
      k := k + 1;
    end;
  end;
end;

function FinallArr(X, Y: TArray): TArray; stdcall;
var
  i,k: integer;
begin
  k := length(X) + length(Y); //считаем размерность нового массива
  SetLength(Result,k);        //устанавливаем размерность нового массива
  k := 0;                     //индекс в новом массиве
//************************записываем в результат массив Х*********************//
  for i  := 0 to length(X)-1 do
  begin
    Result[k] := X[i];
    k := k + 1;
  end;
//*********************аписываем в результат массив Y*************************//
  for i  := 0 to length(Y) - 1 do
  begin
    Result[k] := Y[i];
    k := k + 1;
  end;
end;

exports
  Negativ, Interval, MaxElement, FinallArr;

begin
end.

Теперь код программы котрой обращается

Код


unit Unit1;

interface

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

type  
  TArray = array of real;

type
  TForm1 = class(TForm)
    PanelInterval: TPanel;
    MemoInt: TMemo;
    Button5: TButton;
    Edit6: TEdit;
    Edit7: TEdit;
    Label9: TLabel;
    Label10: TLabel;
    Label11: TLabel;
    Label12: TLabel;
    PanelX: TPanel;
    Button1: TButton;
    MemoX: TMemo;
    Edit1: TEdit;
    Label8: TLabel;
    Edit2: TEdit;
    Label13: TLabel;
    PanelY: TPanel;
    Button2: TButton;
    Edit3: TEdit;
    MemoY: TMemo;
    Edit4: TEdit;
    PanelNeg: TPanel;
    Button4: TButton;
    Button3: TButton;
    MemoNeg: TMemo;
    PanelFin: TPanel;
    MemoFin: TMemo;
    Button6: TButton;
    Button7: TButton;
    Label1: TLabel;
    Label2: TLabel;
 { function MaxElement; stdcall;
  function  Negativ(X: TArray):TArray; stdcall;
  function  Interval(Y: TArray; a, b: real):TArray; stdcall;
  function  FinallArr(X, Y: TArray): TArray; stdcall;}     
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button4Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);

  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  X,Y,FinArray,Negativs,Intervals: TArray;

function Interval(Y: TArray; a, b: real):TArray; external 'my.dll';
function MaxElement(Z: TArray):real; external 'my.dll';
function Negativ(X: TArray):TArray; external 'my.dll';
function FinallArr(X, Y: TArray):TArray; external 'my.dll';

implementation

{$R *.dfm}

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
var
  i,k: integer;
  s: string;
begin
  SetLength(X, StrToInt(Edit1.Text));
  k := Length(X);
  for i := 0 to k - 1 do
  begin
    X[i] := random(StrToInt(Edit2.Text));
  end;
  for i := 0 to k - 1 do
  begin
    s := s + FloatToStr(X[i]) + ' ';
  end;
  MemoX.Text := s;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Form1.MemoInt.Clear;
  Form1.MemoX.Clear;
  Form1.MemoY.Clear;
  Form1.MemoNeg.Clear;
  Form1.MemoFin.Clear;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  i,k: integer;
  s: string;
begin
  SetLength(Y, StrToInt(Edit3.Text));
  k := Length(Y);
  for i := 0 to k - 1 do
  begin
    Y[i] := random(StrToInt(Edit4.Text));
  end;
  for i := 0 to k -1 do
  begin
    s := s + FloatToStr(Y[i]) + ' ';
  end;
  MemoY.Text := s;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  SetLength(X,0);
  SetLength(Y,0);
end;

procedure TForm1.Button4Click(Sender: TObject);
var
  i,k,dk: integer;
  s: string;
begin
  k := 0;
  dk := 2;
  while k < Length(X) - 1 do
  begin
    X[k] := X[k]*(-1);
    k := k + dk;
  end;
  for i := 0 to Length(X) - 1 do
  begin
    s := s + FloatToStr(X[i]) + ' ';
  end;
  MemoX.Text := s;
end;

procedure TForm1.Button3Click(Sender: TObject);
var
  i: integer;
  s: string;
begin
  Negativs := Negativ(X);
  for i := 0 to Length(Negativs) - 1 do
  begin
    s := s + FloatToStr(Negativs[i]) + ' ';
  end;
  MemoNeg.Text := s;
end;

procedure TForm1.Button5Click(Sender: TObject);
var
  i: integer;
  s: string;
begin
  Intervals := Interval(Y, StrToFloat(Edit6.Text), StrToFloat(Edit7.Text));
  for i := 0 to Length(Intervals) - 1 do
  begin
    s := s + FloatToStr(Intervals[i]) + ' ';
  end;
  MemoInt.Text := s;
end;

procedure TForm1.Button6Click(Sender: TObject);
var
  i: integer;
  s: string;
begin
  FinArray := FinallArr(Negativs,Intervals);
  for i := 0 to Length(FinArray) - 1 do
  begin
    s := s + FloatToStr(FinArray[i]) + ' ';
  end;
  MemoFin.Text := s;
end;

procedure TForm1.Button7Click(Sender: TObject);
var
  max: real;
begin
  max := MaxElement(FinArray);
  Form1.MemoFin.Lines.Add('Максимальный элемент: ' + FloatToStr(max));
end;

end.

Т.е нажимая на кнокпу №3 (procedure TForm1.Button3Click(Sender: TObject);)
Не чего не происходит но выводится сообщение
Access violation at addres 001547Eo in module "my.dll". Write of adress 004530b1.
Есть еще проблемы с динамикой но не знаю что сделать тут.

Это сообщение отредактировал(а) Rrader - 19.12.2009, 09:22

kami

Дата 18.12.2009, 18:58 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1806
Регистрация: 25.8.2007
Где: Санкт-Петербург

Репутация: 22
Всего: 72

В коде программы во всех внешних функциях пропущено stdcall. Либо убрать stdcall из dll либо добавить в основную программу.

alf138

Дата 18.12.2009, 19:20 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 161
Регистрация: 15.11.2009

Репутация: нет
Всего: нет

Спасибо стало запускаться, но после завершения программы пишет "Runtime error 217 at 00402700" с чем это связанно ? (убрал stdcall из dll бмблиотеки)

Это сообщение отредактировал(а) alf138 - 18.12.2009, 19:21

Демо

Дата 18.12.2009, 20:06 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1278
Регистрация: 3.11.2005

Репутация: 7
Всего: 50

У тебя в DLL и основном прложении разные менеджеры памяти.
Либо добавть в DLL и ф файл проекта основного приложения uses ShareMem/FastMem первым модулем, либо выделение/освоюождение памяти делай только в одном месте.

--------------------

alf138

Дата 18.12.2009, 20:32 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 161
Регистрация: 15.11.2009

Репутация: нет
Всего: нет

Дописываю uses ShareMem в dll И программу ошибка все таже 217, пытаюсь прописать FastMem в dll пишет что не нашол FastMem.dcu, как быть ?

Демо

Дата 18.12.2009, 23:03 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1278
Регистрация: 3.11.2005

Репутация: 7
Всего: 50

alf138,

Проверь размер массива Negativ при выполнении Button3Click...

--------------------

alf138

Дата 19.12.2009, 09:15 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 161
Регистрация: 15.11.2009

Репутация: нет
Всего: нет

Код


function Negativ(X: TArray): TArray; stdcall;
var
  i,k: integer;
begin
  k := 0;
  for i := 0 to length(X) - 1 do
  begin
    if X[i] < 0 then k := k + 1;   //размерность нового массива
  end;
  SetLength(Result,k);    //устанавливаем размерность массива

Вот но онаже увеличитватся должна сама ...

alf138

Дата 19.12.2009, 09:50 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 161
Регистрация: 15.11.2009

Репутация: нет
Всего: нет

В динамической загрузке то же пишет ошибку 217, после завершения работы приложения. Процедура Negativ

Код


procedure TForm1.Button3Click(Sender: TObject);
var
  Negativ: TNegativ;
  Handle:  THandle;
  i: integer;
  s: string;
begin
  Handle := 0;
  try
    Handle := LoadLibrary('my.dll');
    if Handle <> 0 then
    begin
      Negativ := GetProcAddress(Handle,'Negativ');
      if Assigned(Negativ) then
      begin
        Negativs := Negativ(X);
        for i := 0 to Length(Negativs) - 1 do
        begin
          s := s + FloatToStr(Negativs[i]) + ' ';
        end;
        MemoNeg.Text := s;
      end
      else
        ShowMessage('Метод не найден');
      end
    else
      ShowMessage('Библиотека не найдена')
    finally
     { if Handle <> 0 then
        FreeLibrary(Handle); }
    end;
  end;

А не связано это с надобностью очищения памяти ? (FreeLibrary(Handle);)

alf138

Дата 19.12.2009, 18:59 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 161
Регистрация: 15.11.2009

Репутация: нет
Всего: нет

Методом помощи товарищей с соседнего форума догнал что ошибка в этих жалких остатках под вечер туплю ужасно подскажите что не так ? Т.е программа запускается но выдает ошибку после закрытия.

Код

 
unit Unit1;

interface

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

type  
  TArray = array of real;

type
  TForm1 = class(TForm)
    PanelInterval: TPanel;
    MemoInt: TMemo;
    Button5: TButton;
    Edit6: TEdit;
    Edit7: TEdit;
    Label9: TLabel;
    Label10: TLabel;
    Label11: TLabel;
    Label12: TLabel;
    PanelX: TPanel;
    Button1: TButton;
    MemoX: TMemo;
    Edit1: TEdit;
    Label8: TLabel;
    Edit2: TEdit;
    Label13: TLabel;
    PanelY: TPanel;
    Button2: TButton;
    Edit3: TEdit;
    MemoY: TMemo;
    Edit4: TEdit;
    PanelNeg: TPanel;
    Button4: TButton;
    Button3: TButton;
    MemoNeg: TMemo;
    PanelFin: TPanel;
    MemoFin: TMemo;
    Button6: TButton;
    Button7: TButton;
    Label1: TLabel;
    Label2: TLabel;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);

  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  X,Y,FinArray,Negativs,Intervals: TArray;

implementation

{$R *.dfm}

{ TForm1 }


procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  SetLength(X,0);
  SetLength(Y,0);
end;
end.

Это сообщение отредактировал(а) alf138 - 19.12.2009, 19:00

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Для новичков \| Следующая тема »