Intel® Fortran Compiler
Build applications that can scale for the future with optimized code designed for Intel® Xeon® and compatible processors.
28950 Discussions

I want to use ShutdownBlockReasonCreate

yu21
Beginner
619 Views

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.

0 Kudos
0 Replies
Reply