- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
I created the following code to detect windows shutdown.
but it's not working properly.
How do I make it work properly?
---code
subroutine SET_SBR(ireg)
!
use, intrinsic :: ISO_C_BINDING
use KERNEL32 !Using the module
use USER32 !Using the module
implicit none !Disable implicit type declaration
ABSTRACT INTERFACE
FUNCTION ShutdownBlockReasonCreate(ihwnd,creason)
!DEC$ ATTRIBUTES STDCALL :: ShutdownBlockReasonCreate
use IFWINTY !Using the module
use, intrinsic :: iso_c_binding
integer(HANDLE) :: ihwnd
!DEC$ ATTRIBUTES REFERENCE, ALLOW_NULL :: crreason
integer(LPCWSTR) :: crreason
END FUNCTION
END INTERFACE
integer :: ireg
integer(HANDLE) :: ihdl
integer::iret
TYPE(C_FUNPTR) :: cp
procedure(ShutdownBlockReasonCreate), pointer :: sbrc
character*256 :: cOldTitle=""C
character*256 :: cNewTitle=""C
integer :: ihead, ilen
integer(LPCWSTR) :: lp
integer(DWORD) :: dwerr
ihdl = LoadLibrary( 'user32.dll' )
cp = transfer(GetProcAddress(ihdl,'ShutdownBlockReasonCreate'),C_NULL_FUNPTR)
call c_f_procpointer( cp, sbrc )
if (.not. associated(sbrc)) then
print *, "ShutdownBlockReasonCreate not supported"
error stop
end if
iret = GetConsoleTitle(cOldTitle,256)
cOldTitle = cOldTitle//C_NULL_CHAR
ilen = len(trim(cOldTitle))
ihead = scan(cOldTitle,'\\',.TRUE.)
cNewTitle = cOldTitle(ihead+1:ilen-1)
ihdl = FindWindow(NULL, cOldTitle)
cNewTitle = trim(cNewTitle)//' is running'//C_NULL_CHAR
lp = loc(cNewTitle)
iret = sbrc(ihdl, lp) !<--- iret is 0
if( iret.eq.0 ) then
dwerr = GetLastError()
end if
return
end
---
If the return value of ShutdownBlockReasonCreate (=sbrc) is normal, it would be non-zero, but it returns 0 and the return value of GetLastErr is 203.
Thank you.
Link Copied

- Subscribe to RSS Feed
- Mark Topic as New
- Mark Topic as Read
- Float this Topic for Current User
- Bookmark
- Subscribe
- Printer Friendly Page