[Fortran] 纯文本查看 复制代码
program s
!<-------------------------------------------------------------------------------------------------------------------------------
use link_cont
use dfwin !< win api
!<-------------------------------------------------------------------------------------------------------------------------------
implicit none
integer(kind=4) :: add
integer(kind=4) :: a,b
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
!<-------------------------------------------------------------------------------------------------------------------------------
!<-------------------------------------------------------------------------------------------------------------------------------
pointer(add,FileOpenCont)
hwnd = LoadLibrary('control.dll'C)
if (hwnd <= 0) then
fail = .true.
syslink = .false.
pause 'DLL Loading failure because control.dll was not found'
else
write(*,*) 'Succeed Contempt DLL (control.dll) Loading'
add = GetProcAddress(hWnd,'FILEOPENCONT'C)
call FileOpenCont(n_case,n_data,lpool,c_files)
endif
end program s
[Fortran] 纯文本查看 复制代码
module link_cont
interface
subroutine FileOpenCont (ncase,ndata,lpool,xfiles)
!MS$ ATTRIBUTES DLLIMPORT :: FileOpenCont
integer(kind=4) :: ncase
integer(kind=4) :: ndata
integer(kind=4) :: lpool
character(len=40), dimension(10) :: xfiles
endsubroutine FileOpenCont
endinterface
endmodule link_cont
[Fortran] 纯文本查看 复制代码
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)
endif
end program s