aur1
Junior Member | Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
! Delphi prototype
! Function wspSPT(const p: Double; const t: Double): Double; stdcall; external 'okawsp6.dll';
program hello
USE ISO_C_BINDING
INTERFACE
FUNCTION LoadLibrary(lpFileName) BIND(C, NAME='LoadLibraryA')
USE ISO_C_BINDING
CHARACTER(KIND=C_CHAR) :: lpFileName(*)
!GCC$ ATTRIBUTES STDCALL :: LoadLibrary
INTEGER(C_INTPTR_T) :: LoadLibrary
END FUNCTION LoadLibrary
FUNCTION GetProcAddress(hModule, lpProcName) &
& BIND(C, NAME='GetProcAddress')
USE ISO_C_BINDING
!GCC$ ATTRIBUTES STDCALL :: GetProcAddress
TYPE(C_FUNPTR) :: GetProcAddress
INTEGER(C_INTPTR_T), VALUE :: hModule
CHARACTER(KIND=C_CHAR) :: lpProcName(*)
END FUNCTION GetProcAddress
FUNCTION FreeLibrary(hModule) BIND(C, NAME='FreeLibrary')
USE ISO_C_BINDING
!GCC$ ATTRIBUTES STDCALL :: FreeLibrary
LOGICAL(C_BOOL) :: FreeLibrary
INTEGER(C_INTPTR_T), VALUE :: hModule
END FUNCTION FreeLibrary
END INTERFACE
INTERFACE
FUNCTION wspSPT(p, t) BIND(C, NAME='wspSPT')
USE ISO_C_BINDING
!GCC$ ATTRIBUTES STDCALL :: wspSPT
real(C_DOUBLE) :: wspSPT
real(C_DOUBLE), VALUE :: p
real(C_DOUBLE), VALUE :: t
END FUNCTION wspSPT
END INTERFACE
integer(C_INTPTR_T) :: hdll
integer(C_INTPTR_T) :: module_handle
! Для теста - получим указатель на FreeLibrary из библиотеки kernel32.dll
TYPE(C_FUNPTR) :: paddr
PROCEDURE(FreeLibrary), BIND(C), POINTER :: pproc
hdll = LoadLibrary(C_CHAR_'kernel32.dll' // C_NULL_CHAR)
print *, 'hdll=', hdll
module_handle = LoadLibrary( Trim(Adjustl('OKAWSP6.DLL')) // char(0) )
! module_handle = LoadLibraryEx('OKAWSP6.DLL', 0, INT('8'X,KIND=C_INT32_T))
print *, 'module_handle=', module_handle
!Выводит module_handle=0
!
paddr = GetProcAddress(hdll, C_CHAR_'FreeLibrary' // C_NULL_CHAR)
if(.not. C_ASSOCIATED(paddr)) &
& error stop 'Unable to obtain procedure address'
print *, 'paddr=', paddr
CALL C_F_PROCPOINTER(paddr, pproc)
print *, 'Result FreeLibrary(hdll)=', pproc(hdll), 'expect .true.'
print *, 'Result FreeLibrary(1)=', pproc(1_C_INTPTR_T) , 'expect .false'
! test
! print *, wspSPT(2500000.0d0,410.1d0)
stop 'stop'
end program
|
Всего записей: 56 | Зарегистр. 28-08-2007 | Отправлено: 09:19 12-04-2021 | Исправлено: aur1, 09:36 12-04-2021 |
|
