Get Error String from windows using FormatMessage API function

Get Error String from windows using FormatMessage API function

I'm trying to use the FormatMessage function to obtain the error message when windows functions fail. The functions I'm particularly interested in are CopyFile and CreateProcess. The follow subroutine is my first attempt to get the error message but so far I've had no joy.

subroutine w32_CheckError

!**********************************************************
! Check for Windows W32 Error And Display Message
!**********************************************************

use dfwin, NULLPTR => NULL
use kernel32

implicit none

! Local Variables
character*255 :: string
integer :: nchar

nchar = FormatMessage(ior(FORMAT_MESSAGE_ALLOCATE_BUFFER,ior(FORMAT_MESSAGE_FROM_SYSTEM, &
                                           FORMAT_MESSAGE_IGNORE_INSERTS)), &
                                          NULL, &
                                          GetLastError(), &
                                          int(MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT),DWORD), & ! Default language
                                          ! LANG_NEUTRAL, & ! Default language
                                          string, &
                                          255, &
                                         NULL)

! Display the string.
if(nchar.gt.0) then
   call grp_message('Windows Error: '//trim(string(1:nchar)))
endif

return
end subroutine

When I try this the contents of string is garbled. Has anyone successfully used this in a FORTRAN context that can tell me what I'm doing wrong.

Thanks in advance.

Steve

21 posts / 0 new
Last post
For more complete information about compiler optimizations, see our Optimization Notice.
Les Neilson's picture

I'm not sure but do you need to call getlasterror first then pass that error code into formatmessage?
Les

Steve Lionel (Intel)'s picture

He's got a call to GetLastError in the argument list. I will have to compare this to a working example I have to see if I can see what might be wrong.

Steve
Repeat Offender's picture


!DEC$ IF(.FALSE.)

module ifwin

   use ISO_C_BINDING

   implicit none

   private

   integer, parameter, public :: DWORD = C_LONG

   integer, parameter, public :: HANDLE = C_INTPTR_T

   integer, parameter, public :: USHORT = C_SHORT

   integer, parameter, public :: BOOL = C_INT

   integer(DWORD), parameter, public :: &

      FORMAT_MESSAGE_ALLOCATE_BUFFER = int(Z'00000100',DWORD)

   integer(DWORD), parameter, public :: &

      FORMAT_MESSAGE_ARGUMENT_ARRAY = int(Z'00002000',DWORD)

   integer(DWORD), parameter, public :: &

      FORMAT_MESSAGE_FROM_HMODULE = int(Z'00000800',DWORD)

   integer(DWORD), parameter, public :: &

      FORMAT_MESSAGE_FROM_STRING = int(Z'00000400',DWORD)

   integer(DWORD), parameter, public :: &

      FORMAT_MESSAGE_FROM_SYSTEM = int(Z'00001000',DWORD)

   integer(DWORD), parameter, public :: &

      FORMAT_MESSAGE_IGNORE_INSERTS = int(Z'00000200',DWORD)

   integer(DWORD), parameter, public :: &

      FORMAT_MESSAGE_MAX_WIDTH_MASK = int(Z'000000FF',DWORD)

   integer(USHORT), parameter, public :: &

      LANG_NEUTRAL = int(Z'0000',USHORT)

   integer(USHORT), parameter, public :: &

      SUBLANG_DEFAULT = int(Z'0001',USHORT)

   integer(USHORT), parameter, public :: &

      SUBLANG_NEUTRAL = int(Z'0000',USHORT)

   integer(BOOL), parameter, public :: TRUE = int(1, BOOL)

   integer(BOOL), parameter, public :: FALSE = int(0, BOOL)

   public FormatMessage

   interface

      function FormatMessage(dwFlags, lpSource, dwMessageId, &

         dwLanguageId, lpBuffer, nSize, Arguments) &

         bind(C, name = 'FormatMessageA')

         import

         implicit none

!GCC$ ATTRIBUTES STDCALL :: FormatMessage

         integer(DWORD) FormatMessage

         integer(DWORD), value :: dwFlags

         integer(HANDLE), value :: lpSource

         integer(DWORD), value :: dwMessageId

         integer(DWORD), value :: dwLanguageId

         type(C_PTR), value :: lpBuffer

         integer(DWORD), value :: nSize

         type(C_PTR), value :: Arguments

      end function FormatMessage

   end interface

   public GetLastError

   interface

      function GetLastError() bind(C, name = 'GetLastError')

         import

         implicit none

!GCC$ ATTRIBUTES STDCALL :: GetLastError

         integer(DWORD) GetLastError

      end function GetLastError

   end interface

   public CopyFile

   interface

      function CopyFile(lpExistingFileName, lpNewFileName, &

         bFailIfExists) bind(C, name = 'CopyFileA')

         import

         implicit none

!GCC$ ATTRIBUTES STDCALL :: CopyFile

         integer(BOOL) CopyFile

         character(kind=C_CHAR) lpExistingFileName(*)

         character(kind=C_CHAR) lpNewFileName(*)

         integer(BOOL), value :: bFailIfExists

      end function CopyFile

   end interface

   public MAKELANGID

   contains

      function MAKELANGID(PrimaryLanguageID, SubLanguageId) &

         bind(C, name='MAKELANGID')

         integer(DWORD) MAKELANGID

         integer(USHORT), value :: PrimaryLanguageID

         integer(USHORT), value :: SubLanguageID
         MAKELANGID = IOR(int(PrimaryLanguageID,DWORD), &

            ISHFT(int(SubLanguageID,DWORD),10))

      end function MAKELANGID

end module ifwin

!DEC$ ENDIF
module string_utils

   use ISO_C_BINDING

   implicit none

   private

   public ftn_strlen

   interface

      function ftn_strlen(str) bind(C, name = 'ftn_strlen')

         import

         implicit none

         integer(C_SIZE_T) ftn_strlen

         type(C_PTR), value :: str

      end function ftn_strlen

   end interface

   public point_deferred

   contains

      function strlen_char(str) bind(C, name = 'ftn_strlen')

         integer(C_SIZE_T) strlen_char

         character(kind=C_CHAR) str(*)
         do strlen_char = 0, huge(strlen_char)-2

            if(str(strlen_char+1) == achar(0)) return

         end do

      end function strlen_char

      subroutine point_deferred(str, fptr, length)

         type(C_PTR), value :: str

         character(:,C_CHAR), pointer :: fptr

         integer(C_SIZE_T), value :: length

         character(length,C_CHAR), pointer :: temp
         call C_F_POINTER(str, temp)

         fptr => temp

      end subroutine point_deferred

end module string_utils
program start

   use ifwin

   use ISO_C_BINDING

   use string_utils

   implicit none

   integer(DWORD) status

   type(C_PTR), target :: lpBuffer

   character(32,C_CHAR) lpExistingFileName

   character(32,C_CHAR) lpNewFileName

   integer(BOOL) bstatus

   integer(DWORD) estatus

   integer(C_SIZE_T) length

   character(:,C_CHAR), pointer :: mess

   integer(HANDLE) lpSource
   lpExistingFileName = 'NoIDontExist.dat'//achar(0)

   lpNewFileName = 'MeNeither.dat'//achar(0)

   bstatus = CopyFile( &

      lpExistingFileName = lpExistingFileName, &

      lpNewFileName = lpNewFileName, &

      bFailIfExists = TRUE)

   estatus = GetLastError()

!   lpSource = transfer(C_NULL_PTR, lpSource) ! Causes ICE

   lpSource = transfer(lpBuffer, lpSource)

   status = FormatMessage( &

      dwFlags = iany([FORMAT_MESSAGE_ALLOCATE_BUFFER, &

         FORMAT_MESSAGE_FROM_SYSTEM,FORMAT_MESSAGE_IGNORE_INSERTS]), &

      lpSource = lpSource, &

      dwMessageId = estatus, &

!      dwLanguageId = MAKELANGID(LANG_NEUTRAL,SUBLANG_NEUTRAL), &

      dwLanguageId = MAKELANGID(LANG_NEUTRAL,SUBLANG_DEFAULT), &

      lpBuffer = C_LOC(lpBuffer), &

      nSize = 255_DWORD, &

      Arguments = C_NULL_PTR)

   write(*,'(a,i0)') 'Return value from CopyFile = ', bstatus

   write(*,'(a,i0)') 'Return value from GetLastError = ', estatus

   length = ftn_strlen(lpBuffer)

   call point_deferred(lpBuffer, mess, length)

   write(*,'(a)') mess

end program start
! Program output (gfortran):

!Return value from CopyFile = 0

!Return value from GetLastError = 2

!The system cannot find the file specified.

Thanks for the information, but do we need to go to so much trouble when a function is already available?

Repeat Offender's picture

Ifort already provides the Windows interfaces, types, and constants, so it doesn't need the stuff between !DEC$ IF(.FALSE.) and !DEC$ ENDIF (lines 1:164) in my example above. I only had that in there because I compiled with gfortran, not having a recent version of ifort. You do need the rest of it, but for some reason the syntax highlighter double-spaces everything you paste into it, so the example would only be about (306-165+1)/2 = 76 lines long, and that's using the verbose format with keywords for actual arguments, which I find more readable for Win32 functions.
Ifort may require some different data types for the Win32 functions because it's written to cray pointers rather than f2003 C interoperability, but the conversion should be should be easy and is left as an exercise to the reader.
Also I meant to set lpBuffer = C_NULL_PTR on line 266, but the value of lpSource is ignored for this value of dwFlags anyway.

Paul Curtis's picture

Windows error reporting can be accomplished a lot more simply; in the following, the error messages are written to text array banner(), which is displayed in its own window.


RECURSIVE SUBROUTINE API_Error (locus, no_errorlog)

	USE kernel32

    IMPLICIT NONE

    INTEGER, INTENT(IN)			    :: locus

	INTEGER, INTENT(IN), OPTIONAL	:: no_errorlog

    INTEGER							:: lastError

    INTEGER							:: rval
	lastError = GetLastError()

	IF (lastError == ERROR_SUCCESS) RETURN
	rval = FormatMessage_G1	(	IOR(FORMAT_MESSAGE_FROM_SYSTEM,		&

									FORMAT_MESSAGE_IGNORE_INSERTS),	&

								NULL,								&

								lastError,							&

								0,									&

								banner(2),	    					&

								LEN(banner(2)),	    				&

								NULL								)

	banner(2) = ADJUSTL(banner(2))
    IF (API_error_report) CALL show_banner (locus)
END SUBROUTINE API_Error

Thanks Paul,

Your routine is similar to what I had originally. I had FORMAT_MESSAGE_ALLOCATE_BUFFER in dwFlags which may be what caused a problem otherwise they are essentially the same.

Is the banner variable is defined in a module (as a character(255) :: banner(2) or similar) that contains this function. What does no_errorlog variable do (there is no check on optional variable - should it be API_error_report and why is function defined as recursive?

I assume this has been cut out of a larger chunk of code.

Steve

Paul Curtis's picture

Yes, this sample was edited a bit. The no_errorlog flag allows error checking to be skipped at certain points in the calling program. The function is recursive since it is called from API wrapper functions in multiple threads. banner() is an array of 255-char strings; the initial member banner(1) is usually preset with content identifying the calling locus, and as shown banner(2) will be filled with the API error message. For example,


rval = CreateDialogParam (GetResDLLInst(), resId, hwndP, &

						  dialogProc, resId)

IF(rval /= 0) THEN

    DialogCreate = rval

ELSE

	banner(1) = 'CreateDialogParam'

    CALL API_Error (812)

    DialogCreate = -1

END IF

Repeat Offender's picture

Quote:

dannycat wrote:

I had FORMAT_MESSAGE_ALLOCATE_BUFFER in dwFlags which may be what caused a problem otherwise they are essentially the same.


FORMAT_MESSAGE_ALLOCATE_BUFFER is the f90 way to do things with dynamic memory. It doesn't in itself cause a problem, but you have to do 3 things to implement the dynamic memory approach.

  1. You have to allocate the memory and get its handle.
    FORMAT_MESSAGE_ALLOCATE_BUFFER tells FormatMessage to allocate memory for the output string. To capture the handle, you want to change the way you invoke FormatMessage a little. First put

    use ISO_C_BINDING
    among your USE statements. Then declare

    integer, parameter :: nbits = bit_size(0_HANDLE)/bit_size(0_byte)
    this gives you the size of a pointer in bytes in case you want the same code to work in both 32- and 64-bit mode. Now you can declare

    character(nbits,C_CHAR) capture
    which gives you the right size of variable to capture the C_PTR that FormatMessage will return as the pointer to the error string in the memory it allocated for you. Now you can change the lpBuffer argument of FormatMessage from string to capture and the nsize argument to 1 because at minimum we need the space for the terminating ASCII NUL.
  2. You need to convert the C_PTR that FormatMessage returned to something Fortran can digest. For this, we need to USE the module that has the conversion subroutine

    use string_utils
    and change the declaration of string to

    character(:,C_CHAR), pointer :: string
    Now we can carry out the conversion given the right kind of subroutine:

    call CharStar2Deferred(transfer(capture,C_NULL_PTR),string)
    string now has your error message and is already just the right length.
  3. Since the dynamic memory wasn't allocated as a Fortran ALLOCABABLE, we are going to need to deallocate it somehow after use. At the end of the subroutine you need

    nchar = LocalFree(transfer(capture,0_HANDLE))
    to do this.

The f90 way seems a little more complicated, but it avoids the f77 dilemma of having to create variables "big enough" to hold the results you get, which can lead to buffer overruns if the variables are too small and is wasteful of resources and time if they are too large.
Oh yes, you need the definition of string_utils:

module string_utils

   use ISO_C_BINDING

   implicit none

   private

   public CharStar2Deferred

   interface

      function ftn_strlen(str) bind(C, name = 'ftn_strlen')

         import

         implicit none

         integer(C_SIZE_T) ftn_strlen

         type(C_PTR), value :: str

      end function ftn_strlen

   end interface

   contains

      subroutine CharStar2Deferred(CharStar, Deferred)

         type(C_PTR), value :: CharStar

         character(:,C_CHAR), pointer, intent(out) :: Deferred

         integer(C_SIZE_T) strlen
         strlen = ftn_strlen(CharStar)

         call point_deferred(CharStar, Deferred, strlen)

      end subroutine CharStar2Deferred

      function strlen_char(str) bind(C, name = 'ftn_strlen')

         integer(C_SIZE_T) strlen_char

         character(kind=C_CHAR) str(*)
         do strlen_char = 0, huge(strlen_char)-2

            if(str(strlen_char+1) == achar(0)) return

         end do

      end function strlen_char

      subroutine point_deferred(str, fptr, length)

         type(C_PTR), value :: str

         character(:,C_CHAR), pointer :: fptr

         integer(C_SIZE_T), value :: length

         character(length,C_CHAR), pointer :: temp
         call C_F_POINTER(str, temp)

         fptr => temp

      end subroutine point_deferred

end module string_utils

Steve Lionel (Intel)'s picture

FWIW, here's a routine I put into the DynamicLoad sample that uses FormatMessage:


! Error processing routine.  Gets the system error and

! its corresponding string, prints a message, then stops

! execution

!

subroutine print_error (string)

use kernel32

implicit none
character(*), intent(IN) :: string
integer(DWORD) last_error

integer(DWORD) nTchars

character(200) message_buffer
! Get the actual system error code

!

last_error = GetLastError ()
! Get the string corresponding to this error

!

nTchars = FormatMessage (FORMAT_MESSAGE_FROM_SYSTEM, & ! dwflags

  NULL, & ! lpsource - ignored

  last_error, & ! dwMessageId

  0, & ! dwLanguageId

  message_buffer, & ! lpBuffer

  len(message_buffer), & !nSize

  NULL) ! Arguments
if (nTchars == 0) then

  write (*,'(A,Z8.8,3A,Z8.8)') "Format message failed for status ", last_error, " while ", &

    string, ": error status = ", GetLastError()

else

  write (*,'(4A)') "Error while ", string, ": ", message_buffer(1:nTchars)

  end if
stop
end subroutine print_error

Steve
Repeat Offender's picture

MSDN warns about using FORMAT_MESSAGE_FROM_SYSTEM without FORMAT_MESSAGE_IGNORE_INSERTS. Also a search found 84 system error codes longer than 200 characters up to code 10401 at 2174 characters, although I suppose this depends on the version of Windows.

Steve Lionel (Intel)'s picture

Thanks for the observations, RO - good points. I also see that one can ask FormatMessage to allocate the message bufffer - think I'll play with that.

Steve
Steve Lionel (Intel)'s picture

Ok, here's a revised version that uses only standard Fortran features (and the Windows API).


subroutine print_error (string)

use kernel32

use, intrinsic :: iso_c_binding

implicit none
character(*), intent(IN) :: string
integer(DWORD) :: last_error

integer(DWORD) :: nTchars

integer(HANDLE) :: ret

type(C_PTR) :: message_buffer_cptr

character, pointer :: message_buffer(:)
! Get the actual system error code

!

last_error = GetLastError ()
! Get the string corresponding to this error

! Use the option to have Windows allocate the message buffer - it puts the

! addess in the lpBuffer argument. Here we pass it the C_PTR message_buffer_cptr,

! using TRANSFER to cast the address to an LPVOID.  FORMAT_MESSAGE_IGNORE_INSERTS

! is used so that it doesn't try looking for arguments - a possible security violation.

! Again, we're using C interoperability features.

!

nTchars = FormatMessage (IOR(IOR(FORMAT_MESSAGE_FROM_SYSTEM, FORMAT_MESSAGE_IGNORE_INSERTS), &

                             FORMAT_MESSAGE_ALLOCATE_BUFFER), & ! dwflags

  NULL, & ! lpsource - ignored

  last_error, & ! dwMessageId

  0, & ! dwLanguageId

  TRANSFER(C_LOC(message_buffer_cptr), 0_LPVOID), & ! lpBuffer

  100, & !nSize - minimum size to allocate

  NULL) ! Arguments
if (nTchars == 0) then

  write (*,'(A,Z8.8,3A,Z8.8)') "Format message failed for status ", last_error, " while ", &

    string, ": error status = ", GetLastError()

else

  ! message_buffer_cptr is now pointing to the message. Use C_F_POINTER to convert

  ! this to an array of characters.

  call C_F_POINTER (message_buffer_cptr, message_buffer, [nTchars])

  write (*,'(3A,*(A))') "Error while ", string, ": ", message_buffer

  ret = LocalFree (TRANSFER(message_buffer_cptr, 0_HANDLE))

  end if
stop
end subroutine print_error

Steve
Repeat Offender's picture

My previous observations were made so that you might read my previous posts to this thread and improve your code accordingly. Let me just point out that you missed a few features that my code had:

  1. I think the syntax with IANY([]) is easier to read than multiple IOR()s and I'm not the only one who thinks that.
  2. Why do you put keywords in comments rather than simply using keyword syntax which is at least as clear and combines compiler checking with your comments?
  3. I also think it's more natural from the Fortran programmers point of view to cast the message to a deferred-length scalar rather than an array of CHARACTER*1 elements. For example "Error while "//string//": "//message_buffer would be OK for the scalar but not the array.
Steve Lionel (Intel)'s picture

1 and 2 are good points. Habits...

3 - Your code, which I had not studied in detail before, uses additional procedures to set the character length. I didn't want to get that complicated in my sample (where this was not the primary thing being illustrated.) I agree that if one wanted to use the message in a string context that your approach would be useful.

Steve
Repeat Offender's picture

The front end procedure was there only to find the length of the NUL-terminated string and the back end procedure created a scope where we could have a pointer to a scalar character variable that we could point at the C string with C_F_POINTER. Since FormatMessage already returns the length we could dispense with all procedure calls in your sample by changing the declaration of message_buffer to


   character(:), pointer :: message_buffer


and then we could replace the line

   call C_F_POINTER (message_buffer_cptr, message_buffer, [nTchars])


with

   BLOCK

      character(nTchars), pointer :: temp

      call C_F_POINTER(message_buffer_cptr,temp)

      message_buffer => temp

   END BLOCK


But I considered the original question to be more like "Help, I've been given a C_PTR the points at a NUL-terminated C string (like C always gives you) and don't know what to do with it." Rather than "I don't know how to make FormatMessage work," so I posted code that converts the C_PTR to a Fortran pointer that points at a deferred-length string. As can be seen, in this case the solution can be more self-contained.

Steve Lionel (Intel)'s picture

Sadly, Intel Fortran doesn't yet support BLOCK. Otherwise, that would be a fine solution.

Steve

Thanks to both of you guys for the info, it has been very helpful. I didn't expect such in depth discussion over what seemed like a fairly straightforward question. I do think there is scope for someone to write a book which covers all aspects of using Window API from a FORTRAN environment. When I initially started using the API back in 2000 I had to use a lot of trial and error approaches, using information from MSDN and Windows programming books (in C) to get certain functions to work however I always found the area not covered very well, from a FORTRAN programmers viewpoint, was dealing with functions that had pointer arguments or returns. I have since found the best way is to look in the ifwin/ifwinty... module sources to identify the actual arguments to use although in this particular case whatever I tried didn't produce a meaningful text string even though the function returned a non zero value. In the module source there is more than one interface defined for FormatMessage which enables both character string and pointers to be used. We now have an example of both.

In your latest example, Steve, is it safe to assume that if the FormatMessage function fails the associated memory for the message buffer pointer has not been allocated? In other words should the LocalFree function be called outside the if/endif structure and after checking status of the pointer?

Steve Lionel (Intel)'s picture

If the return value from FormatMessage is 0 you can assume it failed and did not allocate anything.

There IS a book on calling Windows API code from Fortran, though it is more than a decade old. It still is largely relevant. "Compaq Visual Fortran: A Guide to Developing Windows Applications" by Norman Lawrence. It does not cover all of the APIs, but does have a lot of useful detail.

Steve

Thanks Steve,

I did get this book when it came out and would have been exceptionally useful if I'd had it a few years before it was published. As it was I did find it useful for explaining how to do lots of things I hadn't done before. I would recommend it to anyone attempting windows programming but it would benefit from an update to include the Intel variable definitions (HANDLE, DWORD, FPARAM, etc) and the changes required for 64-bit code etc.

Login to leave a comment.