Dll и функции

[Antistas]

Вопрос более общего характера. В Dll содержится какая то функция которая выводит массив. Программа вызывает эту функцию из библиотеки, проделываются какие то операции и функция возвращает массив.
Я кое какой код написал он выдавал ошибку. Может неправильно выводил этот массив. Как должен выглядеть основной файл и dll?
// немного не оптимизированный , но рабочий метод наискорейшего градиентного спуска

unit megaproj;

interface

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



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

Type
Tarr = array [0..100,1..2] of real;

var
  Form1: TForm1;
  a,b,c: integer;
  d,e,f,g: real;
  res: Tarr;



function MNGS(a,b,c: integer; d,e,f,g: real): Tarr;
external 'mngsdll.dll';

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
a:=strtoint(edit1.text);
b:=strtoint(edit2.text);
c:=strtoint(edit3.text);
d:=strtofloat(edit4.text);
e:=strtofloat(edit5.text);
f:=strtofloat(edit6.text);
g:=strtofloat(edit7.text);
res:=MNGS(a,b,c,d,e,f,g);
end;

end.

library MNGSdll;


uses
  SysUtils,
  Classes;

type
Tarr = array [0..100,1..2] of real;

{$R *.res}
function MNGS(a1,a2,a3: integer; xn,yn,eps1,eps2:real): Tarr ;

const
dx=0.0001;
n=2;

var
i,k,d,m: integer;
t,min,e1, e2,a,b,eps,x1,x2,y1,y2,delta: real;
x: Tarr;
grad: array [0..1,1..2] of real;


  function f(x1,x2: real): real;
    begin
      result:=a1*x1*x1+a2*x1*x2+a3*x2*x2;
    end;

  function gradient(x11: real; x22: real; z: integer): real;
    var
      y: array [1..2] of real;
      aa,bb: real;
    begin
      y[1]:=x11;
      y[2]:=x22;
      aa:=f(y[1],y[2]);
      y[z]:=y[z]+dx;
      bb:=f(y[1],y[2]);
      result:=(bb-aa)/dx;
    end;

  procedure stop(z: integer);
    var
      xz: array [0..1,1..2] of real;
      i: integer;
    begin
      if z=1 then
     // вывод сообщения
      if z=2 then
 // вывод сообщения
      if z=3 then
 // вывод сообщения
      if z=3 then
        begin
         for i:=1 to n do
          begin
            xz[0,i]:=x[k+1,i];

          end;
        end;

      if z<>3 then
        for i:=1 to n do
          begin
            xz[0,i]:=x[k,i];

          end;


    for i:=1 to n  do
 // вывод точки
  end;


begin
k:=0;
M:=30;
d:=0;
x[k,1]:=xn; //0,5
x[k,2]:=yn; //1
e1:=eps1;  //0.001;
e2:=eps2;  //0.0015;

while (d<>1) do
  begin
    for i:=1 to n  do
      grad[0,i]:=gradient(x[k,1],x[k,2],i);

    if sqrt(sqr(grad[0,1])+sqr(grad[0,2]))<e1 then
      //stop(1);
       result:=x;
  if k>=M then
  //  stop(2);
    result:=x;

  a:=-10;
  b:=10;
  eps:=0.001;

			while (b - a>=eps) do
        begin
          x2:= a + (b-a)/((1+sqrt(5))/2);
          x1:= a + b - x2;

          y1:= f(x[k,1]-x1*grad[0,1],x[k,2]-x1*grad[0,2]);
          y2:= f(x[k,1]-x2*grad[0,1],x[k,2]-x2*grad[0,2]);

          if (y1 < y2)   then
			      begin
					    delta:= x2 - x1;
					    b:= x2;
					    x2:= x1;
				    	x1:= a + delta;
				    	y2:= y1;
			      end
				  else
            if (y2 < y1) then
				      begin
					      delta:= x2 - x1;
				      	a := x1;
					      x1 := x2;
					      x1 := b - delta;
                y1 := y2;
				      end

            else
				      begin
					      a:=x1;
				    	  b:=x2;
					      x1:= (a + b) / 2 - sqrt(5) * (b - a) / 2;
					      x2:= (a + b) / 2 + sqrt(5) * (b - a) / 2;
				      end;
			end;

		t:=(a+b)/2;

  for i:=1 to n do
    x[k+1,i]:=x[k,i]-t*gradient(x[k,1],x[k,2],i);

  if (sqrt (sqr(x[k+1,1]-x[k,1])+sqr(x[k+1,2]-x[k,2]))<e2) and
  (abs( f(x[k+1,1],x[k+1,2])  - f(x[k,1],x[k,2]) ) <e2) then
  //  stop(3);
   result:=x;
  k:=k+1;
end;

end;

exports
Mngs;


begin
end.

[veniside]

> было примерно так

Ошибка была примерно там.

[Antistas]

Представил полный код программы

[veniside]

на первый взгляд вроде должно работать. Единственно, result не всегда присваивается, но это не фатально. А какая ошибка выдавалась?

[Antistas]

ссылался на память. Access Violation

[GunSmoker]

Включи опцию в настройках проекта "Range Check Error" (как в DLL, так и в exe) и сделай обоим проектам Build (не Run, не Compile, а именно Build).

Теперь запусти. Изменилось что-то?

[veniside]

library MNGSdll;


uses
  SysUtils,
  Classes;

type
Tarr = array [0..100,1..2] of real;

{$R *.res}
function MNGS(a1,a2,a3: integer; xn,yn,eps1,eps2:real): Tarr ;
var
  x: Tarr;
begin
  result:=x;
end;

exports
Mngs;


begin
end.

Короче, я оставил только вот такое от библиотеки, и всё отлично работает. Т.е. ошибка явно в алгоритме, который вылазит за диапазон массива. Советую перенести function MNGS() из DLL в основную прогу, там отладить её нормально, а потом уже перенести в DLL рабочую версию функции.

[Antistas]

Сообщение от GunSmoker

Включи опцию в настройках проекта "Range Check Error" (как в DLL, так и в exe) и сделай обоим проектам Build (не Run, не Compile, а именно Build).

Теперь запусти. Изменилось что-то?

теперь вылетает с ошибкой Range Check Error в dll

[Antistas]

Сообщение от veniside

library MNGSdll;


uses
  SysUtils,
  Classes;

type
Tarr = array [0..100,1..2] of real;

{$R *.res}
function MNGS(a1,a2,a3: integer; xn,yn,eps1,eps2:real): Tarr ;
var
  x: Tarr;
begin
  result:=x;
end;

exports
Mngs;


begin
end.

Короче, я оставил только вот такое от библиотеки, и всё отлично работает. Т.е. ошибка явно в алгоритме, который вылазит за диапазон массива. Советую перенести function MNGS() из DLL в основную прогу, там отладить её нормально, а потом уже перенести в DLL рабочую версию функции.

изначально была просто программа с этим алгоритмом. Я её решил перенести в dll. Программа выглядела так.

program Project2;
uses
  SysUtils;
const
dx=0.0001;
n=2;
{$APPTYPE CONSOLE}




var
i,k,d,m: integer;
t,min, e1, e2,a,b,eps,x1,x2,y1,y2,delta: real;
x: array [0..100,1..2] of real;
temp: array[0..101] of real;
grad: array [0..1,1..2] of real;

function f(x1,x2: real): real;
begin
result:=sqr(x1+2)+x2*x2;
//result:=x1*x1*x1-x1*x2+x2*x2-2*x1+3*x2-4;
end;

function gradient(x11: real; x22: real;z: integer): real;
var
y: array [1..2] of real;
aa,bb: real;
begin
y[1]:=x11;
y[2]:=x22;
aa:=f(y[1],y[2]);
y[z]:=y[z]+dx;
bb:=f(y[1],y[2]);
result:=(bb-aa)/dx;
end;

procedure stop(z: integer);
var
xz: array [0..1,1..2] of real;
begin
if z=1 then
writeln('grad < e1');
if z=2 then
writeln('k>=m');
if z=3 then
 writeln('sqrt abs');
writeln;

write('xz=');
if z=3 then
 begin

 for i:=1 to n do
    begin
    xz[0,i]:=x[k+1,i];
    write(xz[0,i]:4:4,' ');
    end;
 end;

if z<>3 then
  for i:=1 to n do
    begin
    xz[0,i]:=x[k,i];
    write(xz[0,i]:4:4,' ');
  end;

writeln('k=',k);
writeln('grad=');
for i:=1 to n  do
write(grad[0,i],' ');

readln;
halt;

end;

begin
k:=0;
M:=30;
d:=0;
x[k,1]:=0.5;
x[k,2]:=1;
e1:=0.001;
e2:=0.0015;

while(d<>1)
do
begin
for i:=1 to n  do
grad[0,i]:=gradient(x[k,1],x[k,2],i);

if sqrt(sqr(grad[0,1])+sqr(grad[0,2]))<e1 then
stop(1);

if k>=M then
stop(2);

{min:=32000;
i:=0;
t:=-10;
while t<=10 do
begin
temp[i]:=f(x[k,1]-t*grad[0,1],x[k,2]-t*grad[0,2]);
inc(i);
t:=t+1;
end;

for i:=0 to 20 do
      begin
          if (temp[i] < min)  then
          begin
          min:=temp[i];
         // t:=i-50;
         t:=i-10;
          end;
      end;       }

 a:=-10;
 b:=10;
 eps:=0.001;

			while (b - a>=eps) do
      begin
      x2:= a + (b-a)/((1+sqrt(5))/2);
      x1:= a + b - x2;

      y1:= f(x[k,1]-x1*grad[0,1],x[k,2]-x1*grad[0,2]);
      y2:= f(x[k,1]-x2*grad[0,1],x[k,2]-x2*grad[0,2]);

      if (y1 < y2)   then
			begin
					delta:= x2 - x1;
					b:= x2;
					x2:= x1;
					x1:= a + delta;
					y2:= y1;
			end
				else
        if (y2 < y1) then
				begin
					delta:= x2 - x1;
					a := x1;
					x1 := x2;
					x1 := b - delta;
					y1 := y2;
				end

				else
				begin
					a:=x1;
					b:=x2;
					x1:= (a + b) / 2 - sqrt(5) * (b - a) / 2;
					x2:= (a + b) / 2 + sqrt(5) * (b - a) / 2;
				end;
			end;

		t:=(a+b)/2;

for i:=1 to n do
x[k+1,i]:=x[k,i]-t*gradient(x[k,1],x[k,2],i);

if (sqrt (sqr(x[k+1,1]-x[k,1])+sqr(x[k+1,2]-x[k,2]))<e2) and
(abs( f(x[k+1,1],x[k+1,2])  - f(x[k,1],x[k,2]) ) <e2) 
then
stop(3);

k:=k+1;
end;


end.

И она вполне рабочая. Я просто убрал writeln, readln, halt. Так как была консольная программа. Насчет halt. Если его не убирать то программа совершенно спокойно завершается без ошибок. То есть получается процесс до него доходит. Если его убрать то получается программа из dll выйти не может и выходит с ошибкой. Такое вероятно?

[veniside]

> И она вполне рабочая.

Ну так при переносе в ДЛЛ ты всё переделал. Толку, что она рабочая.

В общем, это уже не так важно, т.к.:

> теперь вылетает с ошибкой Range Check Error в dll

Ищи, где и почему выходишь за границы массива.