1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37
| subroutine test
use user32
use kernel32
implicit none
pointer (p_seta, seta)
integer(HANDLE) :: dll_handle
integer(BOOL) :: free_status
integer i
real AP
common /X/C,B,A
real C,B,A
Interface
subroutine Seta
!DEC$ ATTRIBUTES DLLIMPORT:: Seta, /X/
implicit none
common /X/C,B,A
real C,B,A
end subroutine Seta
end interface
!==========================================!
dll_handle = LoadLibrary ("DLL_a.dll"C)
if (dll_handle == NULL) then
! Echec
stop
end if
p_seta = GetProcAddress (dll_handle, "Seta"C)
if (p_Seta == NULL) then
! Echec
stop
end if
! appelle la fonction seta
call seta ! la valeur de A dans la DLL est 1
Ap=A ! la valeur de A dans la subroutine test est 0
free_status = freelibrary(p_seta)
end subroutine Test |