Пример создания DLL на Fortran и вызова ее на других языках

Функция на Фортране, тип проекта - Fortran DLL 


subroutine Dll(a,b)
  ! Expose subroutine Dll to users of this DLL
  !
  !DEC$ ATTRIBUTES DLLEXPORT::Dll
  integer a(10)
  real b

  a=a+b
end subroutine Dll
Вызов на Fortrane (IVF), тип проекта - console 

program Test_dll
!use ifport
!use ifwin
use kernel32

implicit none
character(256) value
character(80) dll_name
character(80) dll_sub_name
integer(handle) lib_handle
integer result

interface
 subroutine sub(x,b)
  implicit none
  integer x(10)
  real b
 end subroutine sub
end interface

pointer (p,sub)
integer  y(10)

dll_name = "dll.dll"
lib_handle = LoadLibrary(dll_name//achar(0))
write(*,'(z16.16)') lib_handle
dll_sub_name = 'DLL'
p = GetProcAddress(lib_handle,"DLL")   ! trim(dll_sub_name)//achar(0))
write(*,'(z16.16)') p
y = 3
call sub(y,7.5)
write(*,*) y
end
Вызов на C++ MVS2010, тип проекта - console 

// TestDLL_CPP.cpp: определяет точку входа для консольного приложения.
//
#include 
#include "stdafx.h"
typedef	void (*FP)(int * a,float *b);

int _tmain(int argc, _TCHAR* argv[])
{   HMODULE dll;
   FP fp;
   int a[10];
   float b=155;
   for (int i = 0; i < 10; i++) a[i]=i;

   dll=LoadLibrary(TEXT("dll.dll"));
   if(!dll)
   {
	puts("DLL.dll не загружена");
	return GetLastError();
   }
   fp=(FP)GetProcAddress(dll,"DLL");
   if (fp!=NULL)
   {
		fp(a,&b);
   }
   else
   {
	puts("Ошибка получения адреса функции");
	return GetLastError();
   }
	// Отключаем библиотеку
   if(!FreeLibrary(dll))
   {
	puts("Ошибка выгрузки библиотеки из памяти");
	return GetLastError();
   }
   return 0;
}
Вызов на C++ Embarcadero BUILDER, тип проекта - console 

#include 
#pragma hdrstop
#pragma argsused

#include 
#include 

typedef	void (*FP)(int * a,float *b);

int _tmain(int argc, _TCHAR* argv[])
{
   HMODULE dll;
   FP fp;
   int a[10];
   float b=155;
   for (int i = 0; i < 10; i++) a[i]=i;

   dll=LoadLibrary(TEXT("dll.dll"));
   if(!dll)
   {
	puts("DLL.dll не загружена");
	return GetLastError();
   }
   fp=(FP)GetProcAddress(dll,"DLL");
   if (fp!=NULL)
   {
		fp(a,&b);
   }
   else
   {
	puts("Ошибка получения адреса функции");
	return GetLastError();
   }
	// Отключаем библиотеку
   if(!FreeLibrary(dll))
   {
	puts("Ошибка выгрузки библиотеки из памяти");
	return GetLastError();
   }
   return 0;
}

Продолжение с взаимным вызовом функций

При передаче строковых параметров могут возникнуть проблемы - в разных компиляторах Fortranа строки передаются по разному 

extern "C" void DLL1(int &n1,int &n,char *a,int al,char *b,int bl,char *c,int cl);

void _tmain(int argc, _TCHAR* argv[])
{
	char c[20]="33333";
	int n1,n;
	n1=1;
	n=2;

	DLL1(n1,n,"1111",7,"22222",20,c,strlen(c));
}




subroutine Dll1(N1,n,a,b,c)
character(len=*) a,b,c
integer n,N1
  !DEC$ ATTRIBUTES DLLEXPORT::Dll1

 ! длина строковых переменных кладется в стек сразу за указателем на строку
 !DEC$ ATTRIBUTES MIXED_STR_LEN_arg::DLL1

  print *,n1,n
  print *,a
  print *,b
  print *,c
end subroutine Dll1
Hosted by uCoz