module link_cont interface subroutine I_FileOpenCont (ncase,ndata,lpool,xfiles) integer(kind=4) :: ncase integer(kind=4) :: ndata integer(kind=4) :: lpool character(len=40), dimension(10) :: xfiles endsubroutine I_FileOpenCont endinterface endmodule link_cont program s use link_cont use Kernel32 use , intrinsic :: ISO_C_Binding !// 标准模块 implicit none type(C_FUNPTR) :: C_FileOpenCont !// C 语言指向函数的指针 procedure(I_FileOpenCont) , pointer :: FileOpenCont !// fortran 指向函数的指针 !<------------------------------------------------------------------------------------------------------------------------------- integer(kind=4) :: add integer(kind=4) :: hwnd integer(kind=4) :: n_case integer(kind=4) :: n_data integer(kind=4) :: lpool character(len=40), dimension(10) :: c_files logical :: fail logical :: syslink !<------------------------------------------------------------------------------------------------------------------------------- hwnd = LoadLibrary('control.dll'//c_null_char) if (hwnd <= 0) then fail = .true. syslink = .false. write(*,*) 'DLL Loading failure because control.dll was not found' read(*,*) else write(*,*) 'Succeed Contempt DLL (control.dll) Loading' add = GetProcAddress(hWnd,'FILEOPENCONT'//c_null_char) !//获得地址(整数) C_FileOpenCont = transfer( add , C_FileOpenCont ) !//把整数的地址转换成 C 指针 call C_F_PROCPOINTER( C_FileOpenCont , FileOpenCont ) !//把C指针转换成 fortran 指针 call FileOpenCont(n_case,n_data,lpool,c_files)
syslink=FreeLibrary(hwnd) endif end program s
在delphi和intel fortran下实证过。