Community
cancel
Showing results for 
Search instead for 
Did you mean: 
Highlighted
Beginner
2 Views

VirtualProtect in kernel32.f90

Looking at the version of kernel32.f90 in C:\Program Files (x86)\Intel\Composer XE 2015\compiler\include

INTERFACE
FUNCTION VirtualProtect( &
        lpAddress, &
        dwSize, &
        flNewProtect, &
        lpflOldProtect)
import
  integer(BOOL) :: VirtualProtect ! BOOL
    !DEC$ ATTRIBUTES DEFAULT, STDCALL, DECORATE, ALIAS:'VirtualProtect' :: VirtualProtect
  integer(LPVOID) lpAddress ! LPVOID lpAddress
  integer(SIZE_T) dwSize ! SIZE_T dwSize
  integer(DWORD) flNewProtect ! DWORD flNewProtect
  integer(LPDWORD) lpflOldProtect ! PDWORD lpflOldProtect
 END FUNCTION
END INTERFACE

 


And then the version in C:\Program Files (x86)\IntelSWTools\compilers_and_libraries_2018.3.210\windows\compiler\include

INTERFACE
FUNCTION VirtualProtect( &
        lpAddress, &
        dwSize, &
        flNewProtect, &
        lpflOldProtect)
import
  integer(BOOL) :: VirtualProtect ! BOOL
    !DEC$ ATTRIBUTES DEFAULT, STDCALL, DECORATE, ALIAS:'VirtualProtect' :: VirtualProtect
  integer(LPVOID) lpAddress ! LPVOID lpAddress
  integer(SIZE_T) dwSize ! SIZE_T dwSize
  integer(DWORD) flNewProtect ! DWORD flNewProtect
  integer(DWORD) lpflOldProtect ! PDWORD lpflOldProtect
  !DEC$ ATTRIBUTES REFERENCE, IGNORE_LOC :: lpflOldProtect
 END FUNCTION
END INTERFACE

 

Running a 64-bit executable, the call in the older ifort version succeeds.  The call in the newer version fails.  May I suggest, from:

 

https://msdn.microsoft.com/en-us/library/windows/desktop/aa366898(v=vs.85).aspx

 

That the correct declaration should be:

 

INTERFACE

FUNCTION VirtualProtect(

. lpAddress,

. dwSize,

. flNewProtect,

. pflOldProtect)

import

integer(BOOL) :: VirtualProtect ! BOOL

!DEC$ ATTRIBUTES DEFAULT, STDCALL, DECORATE :: VirtualProtect

!DEC$ ATTRIBUTES ALIAS:'VirtualProtect' :: VirtualProtect

integer(LPVOID) lpAddress ! LPVOID lpAddress

integer(SIZE_T) dwSize ! SIZE_T dwSize

integer(DWORD) flNewProtect ! DWORD flNewProtect

integer(PDWORD) pflOldProtect ! PDWORD lpflOldProtect

END FUNCTION

END INTERFACE

0 Kudos
4 Replies
Highlighted
Black Belt
2 Views

Unless I am misreading the

Unless I am misreading the documentation, which I suppose is possible, the new interface is correct and should work with old sources that passed LOC(old-protect-variable). The goal of the change, and there are a lot of these in the modules, is to replace "address by value" with "correctly-typed-thing by reference". The IGNORE_LOC allows old code to continue to work.

Can you provide a short but complete example showing what fails (and please elaborate on "fails")?

Steve (aka "Doctor Fortran") - https://stevelionel.com/drfortran
0 Kudos
Highlighted
Beginner
2 Views

This should work with any DLL

This should work with any DLL and function, I picked out dbghelp from v7.1 Windows API (I believe the error is in 4-byte vs 8-byte):

 

      program main
      USE KERNEL32
      USE IFWINTY
      USE ISO_C_BINDING
      
      INTEGER(HANDLE)hLib
      TYPE(C_PTR) PATCHLOC1
      INTEGER(DWORD)iGetLastError
      CHARACTER(100)SLIB
    
      SLIB=
     & "C:\\Program Files\\Debugging Tools for Windows (x64)\\"//
     & "dbghelp.dll"c
      hLib=LoadLibrary(SLIB)
      PATCHLOC1=TRANSFER(GetProcAddress(hLib,"StackWalk64"C),PATCHLOC1)
      CALL DoCrash(PATCHLOC1)
      END
      
      subroutine DoCrash(PFORIGINAL)
      use kernel32
      USE ISO_C_BINDING
C
      TYPE(C_PTR), INTENT(IN) :: PFORIGINAL
      INTEGER(LPVOID) FPFORIGINAL
      TYPE(C_PTR) CPTR_OLDPROTECT
      INTEGER(DWORD) OLDPROTECT
      INTEGER(PDWORD) FPTR_OLDPROTECT
      INTEGER(BOOL) BSUCCESS
      INTEGER(SIZE_T) SIZE
C
      FPFORIGINAL = TRANSFER(PFORIGINAL,FPFORIGINAL)
      CPTR_OLDPROTECT = C_LOC(OLDPROTECT)
      FPTR_OLDPROTECT = TRANSFER(CPTR_OLDPROTECT,FPTR_OLDPROTECT)
      SIZE = 50
      BSUCCESS = VirtualProtect(FPFORIGINAL,SIZE,PAGE_READWRITE,
     &                          FPTR_OLDPROTECT)
      IF (BSUCCESS == 0) THEN
        WRITE(*,*)"Uh oh, failed!"
      ENDIF
C Now, Undo
      BSUCCESS = VirtualProtect(FPFORIGINAL,SIZE,OLDPROTECT,
     &                          FPTR_OLDPROTECT)
      IF (BSUCCESS == 0) THEN
        WRITE(*,*)"Uh oh, failed!"
      ENDIF
      end subroutine

 

0 Kudos
Highlighted
Beginner
2 Views

I forgot to mention, the old

I forgot to mention, the old compiler executes this with both BSUCCESS values being 1, while the new compiler sets BSUCCESS = 0 on the second call.

0 Kudos
Highlighted
Black Belt
2 Views

This fails for you because

This fails for you because you're constructing the OLDPROTECT pointer manually, which is unnecessary and not typical. This works with the new interface.

      subroutine DoCrash(PFORIGINAL)
      use kernel32
      USE ISO_C_BINDING
C
      TYPE(C_PTR), INTENT(IN) :: PFORIGINAL
      INTEGER(LPVOID) FPFORIGINAL
!      TYPE(C_PTR) CPTR_OLDPROTECT
      INTEGER(DWORD) OLDPROTECT
      INTEGER(BOOL) BSUCCESS
      INTEGER(SIZE_T) SIZE
C
      FPFORIGINAL = TRANSFER(PFORIGINAL,FPFORIGINAL)
      !CPTR_OLDPROTECT = C_LOC(OLDPROTECT)
      !FPTR_OLDPROTECT = TRANSFER(CPTR_OLDPROTECT,FPTR_OLDPROTECT)
      SIZE = 50
      BSUCCESS = VirtualProtect(FPFORIGINAL,SIZE,PAGE_READWRITE,
     &                          OLDPROTECT)
      IF (BSUCCESS == 0) THEN
        WRITE(*,*)"Uh oh, failed!"
      ENDIF
C Now, Undo
      BSUCCESS = VirtualProtect(FPFORIGINAL,SIZE,OLDPROTECT,
     &                          OLDPROTECT)
      IF (BSUCCESS == 0) THEN
        WRITE(*,*)"Uh oh, failed!"
      ENDIF
      end subroutine

And this (snippet) works with both old and new:

      BSUCCESS = VirtualProtect(FPFORIGINAL,SIZE,PAGE_READWRITE,
     &                          LOC(OLDPROTECT))
      IF (BSUCCESS == 0) THEN
        WRITE(*,*)"Uh oh, failed!"
      ENDIF
C Now, Undo
      BSUCCESS = VirtualProtect(FPFORIGINAL,SIZE,OLDPROTECT,
     &                          LOC(OLDPROTECT))

Note that you get a compile error with the way you had it, which would be a clue that something needs to change.

Steve (aka "Doctor Fortran") - https://stevelionel.com/drfortran
0 Kudos