[Fortran] 纯文本查看 复制代码
Logical Function WriteResourceToFile( resType , resID , fileName ) result(ok)
use , intrinsic :: ISO_C_Binding
use kernel32 , only : SizeofResource , LockResource , LoadResource , FindResourceEx
Character(Len=*) , intent(IN) :: resType , fileName
Integer , intent(IN) :: resID
character(len=len_trim(resType)+1) :: myType
character , pointer :: pMem(:)
integer :: hRes,hMem, j
type(c_ptr) :: cp
ok = .false.
myType = trim(resType)//c_null_char
hRes = FindResourceEx(0,transfer(c_loc(myType),j),resID,0_2)
if( hRes == 0 ) return
hMem = LoadResource(0,hRes)
if( hMem == 0 ) return
hMem = LockResource( hMem )
if( hMem == 0 ) return
j = SizeofResource(0,hRes)
if( j == 0 ) return
call c_f_pointer( transfer( hMem , cp ) , pMem , [j] )
Open(NewUnit = j , File = fileName , access="stream")
write(j) pMem
Close(j)
ok = .true.
End Function WriteResourceToFile
[Fortran] 纯文本查看 复制代码
Logical Function WriteResourceToFile( resType , resID , fileName ) result(ok)
use , intrinsic :: ISO_C_Binding
use kernel32 , only : WORD,LPVOID,HANDLE, &
SizeofResource , LockResource , LoadResource , FindResourceEx
Character(Len=*) , intent(IN) :: resType , fileName
Integer(LPVOID) , intent(IN) :: resID
integer(HANDLE) :: hRes,hMem
integer :: j
character(len=len_trim(resType)+1) :: myType
character , pointer :: pMem(:)
type(c_ptr) :: cp
ok = .false.
myType = trim(resType)//c_null_char
hRes = FindResourceEx(0_HANDLE,transfer(c_loc(myType),hRes),resID,0_WORD)
if( hRes == 0_HANDLE ) return
hMem = LoadResource(0_HANDLE,hRes)
if( hMem == 0_HANDLE ) return
hMem = LockResource( hMem )
if( hMem == 0_HANDLE ) return
j = SizeofResource(0_HANDLE,hRes)
if( j == 0 ) return
call c_f_pointer( transfer( hMem , cp ) , pMem , [j] )
Open(NewUnit = j , File = fileName , access="stream")
write(j) pMem
Close(j)
ok = .true.
End Function WriteResourceToFile